|
|
| (2 intermediate revisions by the same user not shown) |
| Line 1: |
Line 1: |
| − | Here are my site-specific routines for registering a patient via HL7 messaging:
| + | Removed. |
| − | | |
| − | ; ACSPNT.m --> PROCESS RECEIVED HL7 MESSAGE (ADT-A31) FROM ACS COMPUMD.
| |
| − | ;
| |
| − | ;
| |
| − | ; DBS CALLS:
| |
| − | ; D FILE^DIE REPLACES EXISTING RECORDS
| |
| − | ; D UPDATE^DIE ADDS NEW RECORDS
| |
| − | ;
| |
| − | ; GLOBAL/LOCAL VARIABLES:
| |
| − | ; PIDSEG CURRENT MESSAGE PID SEGMENT
| |
| − | ; PIDSEGNAME TEMP STORAGE OF PATIENT NAME FOR FORMATTING
| |
| − | ; INSSEG ARRAY OF CURRENT MESSAGE IN1 SEGMENTS
| |
| − | ; EVNSEG EVENT SEGMENT *p2
| |
| − | ; PNTROOT FDA_ROOT FOR PATIENT DBS CALLS
| |
| − | ; VALPNTROOT VALIDATED PNTROOT
| |
| − | ; PNTINSROOT FDA_ROOT FOR PATIENT INSURANCE
| |
| − | ; PNTERR ERR MESSAGES FROM PATIENT DBS CALL
| |
| − | ; VALERR ERR MESSAGES FROM VALIDATION CALL
| |
| − | ; INSCOUNT COUNTER FOR INSURANCE ARRAY
| |
| − | ; FDAIEN INTERNAL ENTRY NUMBER DERRIVED FROM PATIENT NUMBER
| |
| − | ; FINDERR ERR MESSAGES FROM FIND^DIC CALL
| |
| − | ; SEG TEMP STORAGE FOR EACH MESSAGE SEGMENT
| |
| − | ; HLMSG MESSAGE CONTROL FOR $$STARTMSG^HLPRS
| |
| − | ; HLMTIENS CURENT MESSAGE RECEIVED
| |
| − | ; HEADER CURRENT MESSAGE HEADER
| |
| − | ; RESULT RETURNED ARRAY FROM FIND^DIC
| |
| − | ; SSNRESULT RESULT OF SOCIAL SECURITY SEARCH
| |
| − | ; SSNFINDERR ERR MESSAGES FROM SOCIAL SECURITY SEARCH
| |
| − | ; SSNFOUND FLAG SET IF SOCIAL SECURITY NUMBER FOUND IN DATABASE
| |
| − | ; SSNIEN IEN OF PATIENT WHERE SSN FOUND *p1
| |
| − | ; VALFLAG SET IF VAL FAILS
| |
| − | ; ^ACSERR LOGFILE FOR VALIDATION ERRORS
| |
| − | ; ERRDATE DATE FOR ERR MESSAGE LOG
| |
| − | ; ^CHECK TEMP STORAGE FOR ERROR MESSAGES
| |
| − | ;
| |
| − | ; COMMENTS:
| |
| − | ; ;) TEMPORARY COMMENT/LINE OF CODE
| |
| − | ;
| |
| − | ; FILEMAN FILES:
| |
| − | ; ^DPT PATIENT (#2)
| |
| − | ;
| |
| − | ; last update 7.05.2007 0847
| |
| − | ; *p1 added 6.26.2007 to account for ssn being reset on filing existing patient information
| |
| − | ; *p2 added 7.02.2007 for coordinating deletion of patient with billing system
| |
| − | ; *p3 added 7.05.2007 to change month name to a number for sorting err message
| |
| − | ;
| |
| − | EN ;entry point, init
| |
| − | N ERRDATE
| |
| − | N FDAIEN
| |
| − | N HLMSG,HEADER,SEG
| |
| − | N PIDSEG,PNTROOT,PNTERR,PIDSEGNAME
| |
| − | N INSCOUNT,INSSEG
| |
| − | N RESULT,FINDERR
| |
| − | N SSNRESULT,SSNFINDERR,SSNFOUND,SSNIEN
| |
| − | N VALPNTROOT,VALFLAG,VALERR
| |
| − | K ^CHECK
| |
| − | S VALFLAG=0
| |
| − | S SSNIEN=0
| |
| − | S ^CHECK("0BEGIN")="VERSION 4.5 - START" ;)
| |
| − | S SSNFOUND=0 ;set ssn found flag to false
| |
| − | S DUZ=1,DUZ(0)="@" ;initialize user number and give programmer access to files
| |
| − | ;set current d/t
| |
| − | N TEMPDATE
| |
| − | D DT^DILF("ERSX","NOW",.TEMPDATE)
| |
| − | S ERRDATE=TEMPDATE(0)
| |
| − | D MODERRDATE ;*p3
| |
| − | K TEMPDATE
| |
| − | GETHEADER ;
| |
| − | ;
| |
| − | ;get received message header using HLMTIENS(last message received)
| |
| − | I $$STARTMSG^HLPRS(.HLMSG,HLMTIENS,.HEADER) G GETSEGMENT
| |
| − | ;
| |
| − | ;Fall through if message not found
| |
| − | S ^ACSERR(ERRDATE,"ACSPNT","ERR")="** Message Not Found (IEN "_HLMTIENS_") **"
| |
| − | G REXIT ;clean-up and quit this routine
| |
| − | GETSEGMENT ;
| |
| − | ;loop through segments
| |
| − | S ^CHECK("0HLMTIENS")=HLMTIENS ;)
| |
| − | S INSCOUNT=0;
| |
| − | F Q:'$$NEXTSEG^HLPRS(.HLMSG,.SEG) D
| |
| − | . I SEG("SEGMENT TYPE")="EVN" ;save EVN segment
| |
| − | . I S EVNSEG("TYPE")=$$GET^HLOPRS(.SEG,1)
| |
| − | . I SEG("SEGMENT TYPE")="PID" ;save PID segment
| |
| − | . I S PIDSEG("NO")=$$GET^HLOPRS(.SEG,3)
| |
| − | . I S PIDSEG("LNAME")=$$GET^HLOPRS(.SEG,5)
| |
| − | . I S PIDSEG("FNAME")=$$GET^HLOPRS(.SEG,5,2)
| |
| − | . I S PIDSEG("MI")=$$GET^HLOPRS(.SEG,5,3)
| |
| − | . I S PIDSEG("REM")=$$GET^HLOPRS(.SEG,6)
| |
| − | . I S PIDSEG("DOB")=$$GET^HLOPRS(.SEG,7)
| |
| − | . I S PIDSEG("SEX")=$$GET^HLOPRS(.SEG,8)
| |
| − | . I S PIDSEG("ADDR1")=$$GET^HLOPRS(.SEG,11)
| |
| − | . I S PIDSEG("ADDR2")=$$GET^HLOPRS(.SEG,11,2)
| |
| − | . I S PIDSEG("CITY")=$$GET^HLOPRS(.SEG,11,3)
| |
| − | . I S PIDSEG("STATE")=$$GET^HLOPRS(.SEG,11,4)
| |
| − | . I S PIDSEG("ZIP")=$$GET^HLOPRS(.SEG,11,5)
| |
| − | . I S PIDSEG("HPHONE")=$$GET^HLOPRS(.SEG,13)
| |
| − | . I S PIDSEG("EMAIL")=$$GET^HLOPRS(.SEG,13,4)
| |
| − | . I S PIDSEG("WPHONE")=$$GET^HLOPRS(.SEG,14)
| |
| − | . I S PIDSEG("SSN")=$$GET^HLOPRS(.SEG,19)
| |
| − | . I SEG("SEGMENT TYPE")="IN1" ;save INS segments
| |
| − | . I ;S INSSEG(INSCOUNT,"PLAN")=$$GET^HLOPRS(.SEG,2) ;same as INS section
| |
| − | . I S INSSEG(INSCOUNT,"INS")=$$GET^HLOPRS(.SEG,3)
| |
| − | . I S INSSEG(INSCOUNT,"NAME")=$$GET^HLOPRS(.SEG,4)
| |
| − | . I S INSSEG(INSCOUNT,"ADDR1")=$$GET^HLOPRS(.SEG,5)
| |
| − | . I S INSSEG(INSCOUNT,"ADDR2")=$$GET^HLOPRS(.SEG,5,2)
| |
| − | . I S INSSEG(INSCOUNT,"CITY")=$$GET^HLOPRS(.SEG,5,3)
| |
| − | . I S INSSEG(INSCOUNT,"STATE")=$$GET^HLOPRS(.SEG,5,4)
| |
| − | . I S INSSEG(INSCOUNT,"ZIP")=$$GET^HLOPRS(.SEG,5,5)
| |
| − | . I S INSSEG(INSCOUNT,"PHONE")=$$GET^HLOPRS(.SEG,7)
| |
| − | . I ;S INSSEG(INSCOUNT,"GRP")=$$GET^HLOPRS(.SEG,8)
| |
| − | . I S INSSEG(INSCOUNT,"NOIL")=$$GET^HLOPRS(.SEG,16)
| |
| − | . I S INSSEG(INSCOUNT,"NOIF")=$$GET^HLOPRS(.SEG,16,2)
| |
| − | . I S INSSEG(INSCOUNT,"NOIM")=$$GET^HLOPRS(.SEG,16,3)
| |
| − | . I S INSSEG(INSCOUNT,"REL")=$$GET^HLOPRS(.SEG,17)
| |
| − | . I S INSSEG(INSCOUNT,"POL")=$$GET^HLOPRS(.SEG,36)
| |
| − | . I S INSCOUNT=INSCOUNT+1
| |
| − | S INSCOUNT=INSCOUNT-1
| |
| − | ;all validation performed on cobol side with exception of SSN.
| |
| − | ;convert DOB from yyyymmdd to mmddyyyy
| |
| − | S PIDSEG("DOB")=$E(PIDSEG("DOB"),5,8)_$E(PIDSEG("DOB"),1,4)
| |
| − | ;set PIDSEGNAME format
| |
| − | S PIDSEGNAME=$G(PIDSEG("LNAME"))_","_$G(PIDSEG("FNAME"))
| |
| − | I $G(PIDSEG("MI"))'="" S PIDSEGNAME=PIDSEGNAME_" "_PIDSEG("MI") ;if midinit exists, append to name
| |
| − | ;set INSSEGNOI format and convert relationship code
| |
| − | N COUNT,TEMP
| |
| − | S COUNT=0
| |
| − | S TEMP=""
| |
| − | F Q:COUNT>INSCOUNT D
| |
| − | . S INSSEG(COUNT,"NOI")=$G(INSSEG(COUNT,"NOIL"))_","_$G(INSSEG(COUNT,"NOIF"))
| |
| − | . I $G(INSSEG(COUNT,"NOIM"))'="" S INSSEG(COUNT,"NOI")=INSSEG(COUNT,"NOI")_" "_INSSEG(COUNT,"NOIM")
| |
| − | . I INSSEG(COUNT,"REL")="0" S TEMP="PATIENT"
| |
| − | . I INSSEG(COUNT,"REL")="1" S TEMP="SPOUSE"
| |
| − | . I INSSEG(COUNT,"REL")="2" S TEMP="NATURAL CHILD"
| |
| − | . I TEMP="" S TEMP="DO NOT USE"
| |
| − | . S INSSEG(COUNT,"REL")=TEMP
| |
| − | . S TEMP=""
| |
| − | . S COUNT=COUNT+1
| |
| − | K COUNT,TEMP
| |
| − | M ^CHECK("1PATIENTINFO")=PIDSEG ;)
| |
| − | M ^CHECK("1INSURANCE")=INSSEG ;)
| |
| − | M ^CHECK("1EVENT")=EVNSEG ;)
| |
| − | I EVNSEG("TYPE")="A29" ;*p2 delete message received
| |
| − | I D DELETEPAT
| |
| − | I G REXIT
| |
| − | D EN^ACSPNT2 ;do insurance company processing
| |
| − | I VALFLAG G REXIT ;if validation fails in ACSPNT2, quit
| |
| − | ;
| |
| − | ;
| |
| − | PROCESSPATIENT ;
| |
| − | ;)FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
| |
| − | ;)finds ACS patient number in ^DPT : Patient File (#2)
| |
| − | ;)RETURNED VALUES
| |
| − | ;) List ^FOUND
| |
| − | ;) ^FOUND("DILIST",0)="1^*^0^" <--1ST NUMBER IS HOW MANY FOUND (0 OR 1)
| |
| − | ;) ^FOUND("DILIST",2,1)=1 <--IEN
| |
| − | ;)USE THIS TO ADD NEW PATIENT WITH ACSPATNO (CROSS REF IEN)
| |
| − | ;)S ^DPT("ACSPATNO",(patient number from acs),1)="" <--1 EQUALS IEN
| |
| − | ;
| |
| − | I PIDSEG("SSN")'?9N S PIDSEG("SSN")="" ;if ssn is != to pattern (9 numbers), set to ""
| |
| − | E D FIND^DIC(2,,"@","X",PIDSEG("SSN"),,"SSN",,,"SSNRESULT","SSNFINDERR")
| |
| − | M ^CHECK("2SSNRESULT")=SSNRESULT ;)
| |
| − | M ^CHECK("2SSNFINDERR")=SSNFINDERR ;)
| |
| − | I PIDSEG("SSN")="" S PIDSEG("SSN")="@" G CHECKACSPATNO ;if ssn blank, set to "@"
| |
| − | I $P(SSNRESULT("DILIST",0),"^",1)'=0 S SSNFOUND=1 ;if found ssn, set ssn found flag to true
| |
| − | I S SSNIEN=SSNRESULT("DILIST",2,1) ;*p1
| |
| − | S ^CHECK("2SSNFLAG")=SSNFOUND ;)
| |
| − | CHECKACSPATNO ;
| |
| − | M ^CHECK("3PROCESSEDSSN")=PIDSEG("SSN") ;)
| |
| − | D FIND^DIC(2,,"@","X",PIDSEG("NO"),,"ACSPATNO",,,"RESULT","FINDERR")
| |
| − | M ^CHECK("4FINDERR")=FINDERR ;)
| |
| − | M ^CHECK("4FINDRESULT")=RESULT ;)
| |
| − | I $P(RESULT("DILIST",0),"^",1)=0 G DOUPDATEDIE ;if no entries for ACSPATNO found, go to update (add)
| |
| − | ;fall through for found entry
| |
| − | ;
| |
| − | ;
| |
| − | DOFILEDIE ;
| |
| − | ;set fields using $GET ($G) to avoid 'variable undefined' error
| |
| − | N TEMPIEN
| |
| − | S TEMPIEN=RESULT("DILIST",2,1)
| |
| − | S FDAIEN=RESULT("DILIST",2,1)_"," ;set IEN from returned array plus comma
| |
| − | I TEMPIEN=SSNIEN G DOFILEDIENEXT ;*p1
| |
| − | I SSNFOUND S PIDSEG("SSN")="@" ;if ssn exists in database, set ssn to @ to avoid duplicate ssn error on add new entry
| |
| − | DOFILEDIENEXT ;*p1
| |
| − | I PIDSEG("SSN")="@" S PNTROOT(2,FDAIEN,.363)="--"
| |
| − | I S PNTROOT(2,FDAIEN,.364)=""
| |
| − | I 'SSNFOUND S PNTROOT(2,FDAIEN,.363)=PIDSEG("SSN")
| |
| − | I S PNTROOT(2,FDAIEN,.364)=$E(PIDSEG("SSN"),6,9)
| |
| − | I S PNTROOT(2,FDAIEN,.09)=PIDSEG("SSN")
| |
| − | K TEMPIEN
| |
| − | S ^CHECK("5FILEIEN")=FDAIEN ;)
| |
| − | S PNTROOT(2,FDAIEN,.01)=PIDSEGNAME
| |
| − | S PNTROOT(2,FDAIEN,.091)=$G(PIDSEG("REM"))
| |
| − | S PNTROOT(2,FDAIEN,.03)=$G(PIDSEG("DOB"))
| |
| − | S PNTROOT(2,FDAIEN,.02)=$G(PIDSEG("SEX"))
| |
| − | S PNTROOT(2,FDAIEN,.301)="NO"
| |
| − | S PNTROOT(2,FDAIEN,391)="NON-VETERAN (OTHER)"
| |
| − | S PNTROOT(2,FDAIEN,1901)="NO"
| |
| − | S PNTROOT(2,FDAIEN,.111)=$G(PIDSEG("ADDR1"))
| |
| − | S PNTROOT(2,FDAIEN,.112)=$G(PIDSEG("ADDR2"))
| |
| − | S PNTROOT(2,FDAIEN,.114)=$G(PIDSEG("CITY"))
| |
| − | S PNTROOT(2,FDAIEN,.115)=$G(PIDSEG("STATE"))
| |
| − | S PNTROOT(2,FDAIEN,.116)=$G(PIDSEG("ZIP"))
| |
| − | S PNTROOT(2,FDAIEN,.131)=$G(PIDSEG("HPHONE"))
| |
| − | S PNTROOT(2,FDAIEN,.132)=$G(PIDSEG("WPHONE"))
| |
| − | S PNTROOT(2,FDAIEN,.133)=$G(PIDSEG("EMAIL"))
| |
| − | S FDAIEN=RESULT("DILIST",2,1) ;set IEN from returned array minus comma
| |
| − | S ^CHECK("5FILEIEN2")=FDAIEN ;)
| |
| − | ;do validation
| |
| − | D VALS^DIE("","PNTROOT","VALPNTROOT","VALERR")
| |
| − | N INDEX,ERRNUM,ERRCOUNT
| |
| − | S INDEX=""
| |
| − | S ERRCOUNT=1
| |
| − | F S INDEX=$O(VALPNTROOT(2,FDAIEN_",",INDEX)) Q:INDEX="" D
| |
| − | . I VALPNTROOT(2,FDAIEN_",",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
| |
| − | . I S ^ACSERR(ERRDATE,"ACSPNT","FILE ERRNUM")=ERRNUM
| |
| − | . I D LOGERR
| |
| − | . I Q
| |
| − | K INDEX,ERRNUM,ERRCOUNT
| |
| − | ;
| |
| − | ;begin file locks
| |
| − | FILELOCKDPT ;
| |
| − | L +^DPT(FDAIEN):1 ;try lock
| |
| − | I $T G DOFILEDIEFILER ;if lock, continue
| |
| − | E G FILELOCKDPT ;if lock fails, keep trying
| |
| − | ;end locks
| |
| − | ;
| |
| − | DOFILEDIEFILER ;
| |
| − | D FILE^DIE("S","VALPNTROOT","PNTERR")
| |
| − | M ^CHECK("5FILE")=PNTERR ;)
| |
| − | ;delete previously saved insurances
| |
| − | N COUNT,DELROOT,DELIEN
| |
| − | S COUNT=1
| |
| − | F Q:COUNT>5 D
| |
| − | . S DELIEN=COUNT_","_FDAIEN_","
| |
| − | . S DELROOT(2.312,DELIEN,.01)="@"
| |
| − | . D FILE^DIE("E","DELROOT")
| |
| − | . S COUNT=COUNT+1
| |
| − | K COUNT,DELROOT,DELIEN
| |
| − | ;add current insurances from message
| |
| − | N COUNT,ADDROOT,ADDIEN
| |
| − | S COUNT=0
| |
| − | F Q:COUNT>INSCOUNT D
| |
| − | . S ADDIEN="?+1,"_FDAIEN_","
| |
| − | . S ADDROOT(2.312,ADDIEN,.01)=INSSEG(COUNT,"NAME")
| |
| − | . S ADDROOT(2.312,ADDIEN,17)=INSSEG(COUNT,"NOI")
| |
| − | . S ADDROOT(2.312,ADDIEN,16)=INSSEG(COUNT,"REL")
| |
| − | . S ADDROOT(2.312,ADDIEN,1)=INSSEG(COUNT,"POL")
| |
| − | . D UPDATE^DIE("E","ADDROOT")
| |
| − | . S COUNT=COUNT+1
| |
| − | K COUNT,ADDROOT,ADDIEN
| |
| − | ;unlock file
| |
| − | L -^DPT(FDAIEN)
| |
| − | S ^ACSERR(ERRDATE,"FILER COMPLETE")="("_PIDSEG("NO")_")"_PIDSEGNAME ;)
| |
| − | G REXIT ;clean-up and quit this routine
| |
| − | ;
| |
| − | DOUPDATEDIE ;
| |
| − | ;set fields using $GET ($G) to avoid 'variable undefined' error
| |
| − | I SSNFOUND S PIDSEG("SSN")="@" ;if ssn exists in database, set ssn to @ to avoid duplicate ssn error on add new entry
| |
| − | E S PNTROOT(2,"+1,",.363)=PIDSEG("SSN")
| |
| − | E S PNTROOT(2,"+1,",.364)=$E(PIDSEG("SSN"),6,9)
| |
| − | E S PNTROOT(2,"+1,",.09)=PIDSEG("SSN")
| |
| − | I PIDSEG("SSN")="@" S PNTROOT(2,"+1,",.363)="--"
| |
| − | I S PNTROOT(2,"+1,",.364)=""
| |
| − | S PNTROOT(2,"+1,",.01)=$G(PIDSEGNAME)
| |
| − | S PNTROOT(2,"+1,",.091)=$G(PIDSEG("REM"))
| |
| − | S PNTROOT(2,"+1,",.03)=$G(PIDSEG("DOB"))
| |
| − | S PNTROOT(2,"+1,",.02)=$G(PIDSEG("SEX"))
| |
| − | S PNTROOT(2,"+1,",.301)="NO"
| |
| − | S PNTROOT(2,"+1,",391)="NON-VETERAN (OTHER)"
| |
| − | S PNTROOT(2,"+1,",1901)="NO"
| |
| − | S PNTROOT(2,"+1,",.111)=$G(PIDSEG("ADDR1"))
| |
| − | S PNTROOT(2,"+1,",.112)=$G(PIDSEG("ADDR2"))
| |
| − | S PNTROOT(2,"+1,",.114)=$G(PIDSEG("CITY"))
| |
| − | S PNTROOT(2,"+1,",.115)=$G(PIDSEG("STATE"))
| |
| − | S PNTROOT(2,"+1,",.116)=$G(PIDSEG("ZIP"))
| |
| − | S PNTROOT(2,"+1,",.131)=$G(PIDSEG("HPHONE"))
| |
| − | S PNTROOT(2,"+1,",.132)=$G(PIDSEG("WPHONE"))
| |
| − | S PNTROOT(2,"+1,",.133)=$G(PIDSEG("EMAIL"))
| |
| − | ;do validation
| |
| − | D VALS^DIE("","PNTROOT","VALPNTROOT","VALERR")
| |
| − | N INDEX,ERRNUM,ERRCOUNT
| |
| − | S INDEX=""
| |
| − | S ERRCOUNT=1
| |
| − | F S INDEX=$O(VALPNTROOT(2,"+1,",INDEX)) Q:INDEX="" D
| |
| − | . I VALPNTROOT(2,"+1,",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
| |
| − | . I S ^ACSERR(ERRDATE,"ACSPNT","UPDATE ERRNUM")=ERRNUM
| |
| − | . I D LOGERR
| |
| − | . I S VALFLAG=1
| |
| − | . I Q
| |
| − | K INDEX,ERRNUM,ERRCOUNT
| |
| − | I VALFLAG G REXIT ;QUIT IF VALIDATION FAILS
| |
| − | ;
| |
| − | DOUPDATEDIEFILER ;
| |
| − | S PNTERR("DIERR")=""
| |
| − | D UPDATE^DIE("S","VALPNTROOT","FDAIEN","PNTERR")
| |
| − | M ^CHECK("6UPDATEIEN")=FDAIEN ;)
| |
| − | I $G(FDAIEN(1))'="" S ^DPT("ACSPATNO",PIDSEG("NO"),FDAIEN(1))="" ;set up my cross-reference
| |
| − | M ^CHECK("6UPDATE")=PNTERR ;)
| |
| − | ;FILE HEALTH RECORD NUMBER
| |
| − | I $G(FDAIEN(1))'="" D EN^ACSPNT3
| |
| − | ;ADD insurance to new patient
| |
| − | S ^DPT(FDAIEN(1),.312,"?+",0)="" ;avoid getting error message of var not found when setting policy number for insurance
| |
| − | N COUNT
| |
| − | S COUNT=0
| |
| − | N PNTINSIEN,VALPNTINSROOT,PNTINSROOT
| |
| − | F Q:COUNT>INSCOUNT D
| |
| − | . S PNTINSIEN="?+1,"_FDAIEN(1)_","
| |
| − | . S PNTINSROOT(2.312,PNTINSIEN,.01)=INSSEG(COUNT,"NAME")
| |
| − | . S PNTINSROOT(2.312,PNTINSIEN,17)=INSSEG(COUNT,"NOI")
| |
| − | . S PNTINSROOT(2.312,PNTINSIEN,16)=INSSEG(COUNT,"REL")
| |
| − | . S PNTINSROOT(2.312,PNTINSIEN,1)=INSSEG(COUNT,"POL")
| |
| − | . ;D VALS^DIE("","PNTINSROOT","VALPNTINSROOT","VALERR")
| |
| − | . D UPDATE^DIE("E","PNTINSROOT") ;SET TO VALPNTINSROOT IF USING VAL^DIE AND TAKE OUT "E" FLAG
| |
| − | . S COUNT=COUNT+1
| |
| − | K PNTINSIEN,VALPNTINSROOT,PNTINSROOT
| |
| − | K COUNT
| |
| − | S ^ACSERR(ERRDATE,"UPDATE COMPLETE")="("_PIDSEG("NO")_")"_PIDSEGNAME ;)
| |
| − | G REXIT ;clean-up and quit routine
| |
| − | ;
| |
| − | REXIT ;
| |
| − | K ERRDATE
| |
| − | K HLMSG,HEADER,SEG,FDAIEN
| |
| − | K PIDSEG,PNTROOT,PNTERR,PIDSEGNAME
| |
| − | K INSCOUNT,INSSEG
| |
| − | K RESULT,FINDERR
| |
| − | K SSNRESULT,SSNFINDERR,SSNFOUND,SSNIEN
| |
| − | K VALPNTROOT,VALFLAG,VALERR
| |
| − | S ^CHECK("9END")="VERSION 4.5 - COMPLETE" ;)
| |
| − | Q
| |
| − | ;
| |
| − | LOGERR ;
| |
| − | F Q:ERRCOUNT>ERRNUM D
| |
| − | . M ^ACSERR(ERRDATE,"ERR TEXT")=VALERR("DIERR",ERRCOUNT,"TEXT")
| |
| − | . S ERRCOUNT=ERRCOUNT+1
| |
| − | Q
| |
| − | ;
| |
| − | DELETEPAT ;*p2
| |
| − | D FIND^DIC(2,,"@","X",PIDSEG("NO"),,"ACSPATNO",,,"RESULT","FINDERR")
| |
| − | I $P(RESULT("DILIST",0),"^",1)=0 G DELETENOTFOUND
| |
| − | N DELIEN,DELIEN2
| |
| − | S DELIEN=RESULT("DILIST",2,1) ;patient IEN from matched ACSPATNO
| |
| − | S DELIEN2=DELIEN
| |
| − | DELETELOCK ;
| |
| − | L +^DPT(DELIEN2):1 ;try lock
| |
| − | I $T G DODELETE ;if lock, continue
| |
| − | E G DELETELOCK ;if lock fails, keep trying
| |
| − | DODELETE ;
| |
| − | S DELIEN=DELIEN_","
| |
| − | S PNTROOT(2,DELIEN,.09)="@"
| |
| − | S PNTROOT(2,DELIEN,.363)="--"
| |
| − | S PNTROOT(2,DELIEN,.364)=""
| |
| − | D FILE^DIE("","PNTROOT") ;delete SSN from patient
| |
| − | L -^DPT(DELIEN2)
| |
| − | K PNTROOT
| |
| − | DELETELOCK2 ;
| |
| − | L +^AUPNPAT(DELIEN2):1
| |
| − | I $T G DODELETE2
| |
| − | E G DELETELOCK2
| |
| − | DODELETE2 ;
| |
| − | S DELIEN=DUZ(2)_","_DELIEN
| |
| − | S PNTROOT(9000001.41,DELIEN,.02)="d"_PIDSEG("NO")
| |
| − | D FILE^DIE("","PNTROOT") ;change HRN to begin with a "d"
| |
| − | L -^AUPNPAT(DELIEN2)
| |
| − | K ^DPT("ACSPATNO",PIDSEG("NO")) ;KILL xREF!!
| |
| − | S ^ACSERR(ERRDATE,"DELETE COMPLETE")="("_PIDSEG("NO")_")"_PIDSEGNAME ;)
| |
| − | K DELIEN,DELIEN2
| |
| − | Q
| |
| − | DELETENOTFOUND ;
| |
| − | S ^ACSERR(ERRDATE,"DELETE COMPLETE")="PATIENT NOT FOUND ("_PIDSEG("NO")_")"_PIDSEGNAME ;)
| |
| − | Q
| |
| − | MODERRDATE ;*p3
| |
| − | S:$P(ERRDATE," ",1)="JAN" $P(ERRDATE," ",1)="01"
| |
| − | S:$P(ERRDATE," ",1)="FEB" $P(ERRDATE," ",1)="02"
| |
| − | S:$P(ERRDATE," ",1)="MAR" $P(ERRDATE," ",1)="03"
| |
| − | S:$P(ERRDATE," ",1)="APR" $P(ERRDATE," ",1)="04"
| |
| − | S:$P(ERRDATE," ",1)="MAY" $P(ERRDATE," ",1)="05"
| |
| − | S:$P(ERRDATE," ",1)="JUN" $P(ERRDATE," ",1)="06"
| |
| − | S:$P(ERRDATE," ",1)="JUL" $P(ERRDATE," ",1)="07"
| |
| − | S:$P(ERRDATE," ",1)="AUG" $P(ERRDATE," ",1)="08"
| |
| − | S:$P(ERRDATE," ",1)="SEP" $P(ERRDATE," ",1)="09"
| |
| − | S:$P(ERRDATE," ",1)="OCT" $P(ERRDATE," ",1)="10"
| |
| − | S:$P(ERRDATE," ",1)="NOV" $P(ERRDATE," ",1)="11"
| |
| − | S:$P(ERRDATE," ",1)="DEC" $P(ERRDATE," ",1)="12"
| |
| − | ;convert to "mm/dd/yyyy" format
| |
| − | S $E(ERRDATE,6)=""
| |
| − | S $E(ERRDATE,3)="/",$E(ERRDATE,6)="/"
| |
| − | Q
| |
| − | | |
| − | | |
| − | | |
| − | | |
| − | | |
| − | | |
| − | ; ACSPNT2.m --> PROCESS RECEIVED HL7 MESSAGE (ADT-A31) FROM ACS COMPUMD.
| |
| − | ; ...continued from ACSPNT.m to process insurance company
| |
| − | ;
| |
| − | ; DBS CALLS:
| |
| − | ; D FILE^DIE REPLACES EXISTING RECORDS
| |
| − | ; D UPDATE^DIE ADDS NEW RECORDS
| |
| − | ;
| |
| − | ; GLOBAL/LOCAL VARIABLES:
| |
| − | ; COUNT COUNTER FOR INSURANCE INDEX
| |
| − | ; INSRESULT RESULT FROM INSURANCE SEARCH
| |
| − | ; INSFINDERR ERR FROM INSURANCE SEARCH
| |
| − | ; INSROOT FDA_ROOT FOR INSURANCE DBS CALLS
| |
| − | ; VALINSROOT VALIDATED INSROOT
| |
| − | ; INSERR ERR MESSAGES FROM INSURANCE DBS CALLS
| |
| − | ; INSIEN IEN FOR DBS CALLS
| |
| − | ; ^CHECK TEMP STORAGE FOR ERR MESSAGES
| |
| − | ;
| |
| − | ; COMMENTS:
| |
| − | ; ;) TEMPORARY COMMENT/LINE OF CODE
| |
| − | ;
| |
| − | ; FILEMAN FILES:
| |
| − | ; ^DIC(36, INSURANCE COMPANY FILE (#36)
| |
| − | ;
| |
| − | ; last update 5.6.2007 1128
| |
| − | ;
| |
| − | EN ;entry point, init
| |
| − | N COUNT
| |
| − | N INSRESULT,INSFINDERR
| |
| − | N VALINSROOT
| |
| − | S COUNT=0
| |
| − | LOOP ;loop through each INS segment
| |
| − | I COUNT>INSCOUNT G REXIT
| |
| − | FINDINS ;
| |
| − | D FIND^DIC(36,,"@","X",INSSEG(COUNT,"INS"),,"ACSINSNO",,,"INSRESULT","INSFINDERR")
| |
| − | M ^CHECK("4INSFINDERR")=INSFINDERR ;)
| |
| − | M ^CHECK("4INSFINDRESULT")=INSRESULT ;)
| |
| − | I $P(INSRESULT("DILIST",0),"^",1)=0 G DOUPDATEDIE ;if no entries for ACSINSNO found, go to update (add)
| |
| − | ;fall through if insurance company found
| |
| − | ;
| |
| − | DOFILEDIE ;
| |
| − | N INSROOT,INSERR
| |
| − | N INSIEN
| |
| − | S INSIEN=INSRESULT("DILIST",2,1)_"," ;set IEN from returned array plus comma
| |
| − | S INSROOT(36,INSIEN,.01)=$G(INSSEG(COUNT,"NAME"))
| |
| − | S INSROOT(36,INSIEN,.05)="NO" ;inactive flag
| |
| − | S INSROOT(36,INSIEN,.111)=$G(INSSEG(COUNT,"ADDR1"))
| |
| − | S INSROOT(36,INSIEN,.112)=$G(INSSEG(COUNT,"ADDR2"))
| |
| − | S INSROOT(36,INSIEN,.114)=$G(INSSEG(COUNT,"CITY"))
| |
| − | S INSROOT(36,INSIEN,.115)=$G(INSSEG(COUNT,"STATE"))
| |
| − | S INSROOT(36,INSIEN,.116)=$G(INSSEG(COUNT,"ZIP"))
| |
| − | S INSROOT(36,INSIEN,.131)=$G(INSSEG(COUNT,"PHONE"))
| |
| − | S INSROOT(36,INSIEN,1)="Y" ;REIMBURSE?
| |
| − | S INSROOT(36,INSIEN,2)="0" ;SIGNATURE REQUIRED ON BILL?
| |
| − | S INSIEN=INSRESULT("DILIST",2,1)
| |
| − | ;do validation
| |
| − | D VALS^DIE("","INSROOT","VALINSROOT","VALERR")
| |
| − | N INDEX,ERRNUM,ERRCOUNT
| |
| − | S INDEX=""
| |
| − | S ERRCOUNT=1
| |
| − | F S INDEX=$O(VALINSROOT(36,INSIEN_",",INDEX)) Q:INDEX="" D
| |
| − | . I VALINSROOT(36,INSIEN_",",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
| |
| − | . I S ^ACSERR(ERRDATE,"ACSPNT2","FILE ERRNUM")=ERRNUM
| |
| − | . I D LOGERR
| |
| − | . I Q
| |
| − | K INDEX,ERRNUM,ERRCOUNT
| |
| − | ;
| |
| − | ;begin file locks
| |
| − | FILELOCKDIC ;
| |
| − | L +^DIC(36,INSIEN):1 ;try lock
| |
| − | I $T G DOFILEDIEFILER ;if lock, continue
| |
| − | E G FILELOCKDIC ;if lock fails, keep trying
| |
| − | ;end locks
| |
| − | ;
| |
| − | DOFILEDIEFILER ;
| |
| − | D FILE^DIE("S","VALINSROOT","INSERR")
| |
| − | L -^DIC(36,INSIEN)
| |
| − | K INSROOT,INSERR
| |
| − | K INSIEN
| |
| − | G NEXTSEGMENT
| |
| − | DOUPDATEDIE ;
| |
| − | N INSROOT,INSERR
| |
| − | N INSIEN
| |
| − | S INSROOT(36,"?+1,",.01)=$G(INSSEG(COUNT,"NAME"))
| |
| − | S INSROOT(36,"?+1,",.05)="NO" ;inactive flag
| |
| − | S INSROOT(36,"?+1,",.111)=$G(INSSEG(COUNT,"ADDR1"))
| |
| − | S INSROOT(36,"?+1,",.112)=$G(INSSEG(COUNT,"ADDR2"))
| |
| − | S INSROOT(36,"?+1,",.114)=$G(INSSEG(COUNT,"CITY"))
| |
| − | S INSROOT(36,"?+1,",.115)=$G(INSSEG(COUNT,"STATE"))
| |
| − | S INSROOT(36,"?+1,",.116)=$G(INSSEG(COUNT,"ZIP"))
| |
| − | S INSROOT(36,"?+1,",.131)=$G(INSSEG(COUNT,"PHONE"))
| |
| − | S INSROOT(36,"?+1,",1)="Y" ;REIMBURSE?
| |
| − | S INSROOT(36,"?+1,",2)="0" ;SIGNATURE REQUIRED ON BILL?
| |
| − | ;do validation
| |
| − | D VALS^DIE("","INSROOT","VALINSROOT","VALERR")
| |
| − | N INDEX,ERRCOUNT,ERRNUM
| |
| − | S INDEX=""
| |
| − | S ERRCOUNT=1
| |
| − | F S INDEX=$O(VALINSROOT(36,"?+1,",INDEX)) Q:INDEX="" D
| |
| − | . I VALINSROOT(36,"?+1,",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
| |
| − | . I S ^ACSERR(ERRDATE,"ACSPNT2","UPDATE ERRNUM")=ERRNUM
| |
| − | . I D LOGERR
| |
| − | . I S VALFLAG=1
| |
| − | . I Q
| |
| − | K INDEX,ERRCOUNT,ERRNUM
| |
| − | I VALFLAG Q ;if validation fails, return to ACSPNT
| |
| − | DOUPDATEDIEFILER ;
| |
| − | ;)S INSERR("DIERR")=""
| |
| − | D UPDATE^DIE("S","VALINSROOT","INSIEN","INSERR")
| |
| − | I $G(INSIEN(1))'="" S ^DIC(36,"ACSINSNO",INSSEG(COUNT,"INS"),INSIEN(1))="ACTIVE" ;set up my cross-reference
| |
| − | K INSROOT,INSERR
| |
| − | K INSIEN
| |
| − | NEXTSEGMENT ;
| |
| − | S COUNT=COUNT+1
| |
| − | G LOOP
| |
| − | REXIT ;
| |
| − | K COUNT
| |
| − | K INSRESULT,INSFINDERR
| |
| − | K VALINSROOT
| |
| − | Q
| |
| − | LOGERR ;
| |
| − | F Q:ERRCOUNT>ERRNUM D
| |
| − | . M ^ACSERR(ERRDATE,"ERR TEXT")=VALERR("DIERR",ERRCOUNT,"TEXT")
| |
| − | . S ERRCOUNT=ERRCOUNT+1
| |
| − | Q
| |
| − | | |
| − | | |
| − | | |
| − | | |
| − | | |
| − | | |
| − | ; ACSPNT3.m --> PROCESS RECEIVED HL7 MESSAGE (ADT-A31) FROM ACS COMPUMD.
| |
| − | ; ...continued from ACSPNT.m to process health record number
| |
| − | ; ...*p1 adds coordinating master of record to patient
| |
| − | ;
| |
| − | ; DBS CALLS:
| |
| − | ; D UPDATE^DIE ADDS NEW RECORDS
| |
| − | ;
| |
| − | ; GLOBAL/LOCAL VARIABLES:
| |
| − | ; FAC USER'S INSTITUTION(FACILITY)
| |
| − | ; PFIEN INTERNAL ENTRY NUMBER IN PATIENT FILE - FROM ACSPNT
| |
| − | ; APN ACS PATIENT NUMBER - FROM ACSPNT
| |
| − | ; HRNROOT ROOT FOR HRN FILE
| |
| − | ; HRNSROOT ROOT FOR HRN SUBFILE
| |
| − | ; HRNIEN INTERNAL ENTRY NUMBER FOR HRN FILE
| |
| − | ; HRNSIEN INTERNAL ENTRY NUMBER FOR HUN SUBFILE
| |
| − | ; HRNERR ERR FOR UPDATE HRN FILE
| |
| − | ; HRNSERR ERR FOR UPDATE HRN SUBFILE
| |
| − | ; PATROOT ROOT FOR PATIENT FILE *p1
| |
| − | ; PATIEN INTERNAL ENTRY NUMBER FOR PATIENT FILE *p1
| |
| − | ; PATERR ERR FOR PATIENT FILE *p1
| |
| − | ; DATE DATE IN INTERNAL FILEMAN FORMAT
| |
| − | ; ^CHECK TEMP STORAGE FOR ERR MESSAGES
| |
| − | ;
| |
| − | ; COMMENTS:
| |
| − | ; ;) TEMPORARY COMMENT/LINE OF CODE
| |
| − | ;
| |
| − | ; FILEMAN FILES:
| |
| − | ; ^AUPNPAT IHS PATIENT (#9000001) 9000001.41 - HRN SUBFILE
| |
| − | ; ^DPT PATIENT FILE (#2) 2.991 - ICN SUBFILE *p1
| |
| − | ;
| |
| − | ; last update 6.26.2007 0954
| |
| − | ; *p1 added 6.26.2007 - this adds ICN to patient only because it is required, and the ICN is not correct
| |
| − | ; for use with MPI as it should be. .04="1" for locally assigned ICN.
| |
| − | ;
| |
| − | EN ;entry point, init
| |
| − | N FAC,HRNROOT,HRNSROOT,HRNIEN,HRNSIEN,HRNERR,HRNSERR
| |
| − | N PFIEN,APN,DATE
| |
| − | N PATROOT,PATIEN,PATERR
| |
| − | S PFIEN=FDAIEN(1)
| |
| − | S APN=PIDSEG("NO")
| |
| − | S FAC=DUZ(2)
| |
| − | D DT^DILF(,"NOW",.DATE)
| |
| − | UPDATE ;
| |
| − | S HRNROOT(9000001,"?+1,",.01)=PFIEN
| |
| − | S HRNROOT(9000001,"?+1,",.02)=DATE
| |
| − | S HRNROOT(9000001,"?+1,",.03)=DATE
| |
| − | S HRNROOT(9000001,"?+1,",.11)=DUZ ;"establishing user"
| |
| − | S HRNROOT(9000001,"?+1,",.12)=DUZ ;"USER LAST UPDATE"
| |
| − | S HRNROOT(9000001,"?+1,",.16)=DATE
| |
| − | D UPDATE^DIE("S","HRNROOT","HRNIEN","HRNERR")
| |
| − | M ^CHECK("HRNERR")=HRNERR ;)
| |
| − | S HRNSIEN(1)=FAC
| |
| − | S HRNSIEN="?+1,"_HRNIEN(1)_","
| |
| − | S HRNSROOT(9000001.41,HRNSIEN,.01)=FAC
| |
| − | S HRNSROOT(9000001.41,HRNSIEN,.02)=APN
| |
| − | D UPDATE^DIE(,"HRNSROOT","HRNSIEN","HRNSERR")
| |
| − | M ^CHECK("HRNSERR")=HRNSERR ;)
| |
| − | FILECMR ; this section is *p1 (CMR - COORDINATING MASTER OF RECORD)
| |
| − | S PATROOT(2,PFIEN_",",991.01)=PFIEN
| |
| − | S PATROOT(2,PFIEN_",",991.03)=FAC
| |
| − | S PATROOT(2,PFIEN_",",991.04)="1" ;locally assigned ICN
| |
| − | D FILE^DIE("S","PATROOT","PATERR")
| |
| − | M ^CHECK("PATCMRERR")=PATERR ;)
| |
| − | REXIT ;EXIT
| |
| − | K FAC,HRNROOT,HRNSROOT,HRNIEN,HRNSIEN,HRNERR,HRNSERR
| |
| − | K PFIEN,APN,DATE
| |
| − | K PATROOT,PATIEN,PATERR
| |
| − | Q
| |
| − | | |
| − | | |
| − | [[User:cmdupre]]
| |
