VistA-WorldVistAEHR/r/DSS_EXTRACTS-ECX/ECXPRO2.m

100 lines
3.5 KiB
Mathematica

ECXPRO2 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ; July 16, 1998
;;3.0;DSS EXTRACTS;**9,15,21,24,33**;Dec 22, 1997
;
ECXBUL(ECXLNE,ECXEBDT,ECXEEDT,ECNUM) ;* Set up the header for the exception msg
;
; Input
; ECXLNE - The line number variable (passed by reference)
; ECXEBDT - The Externally formated beginning date
; ECXEEDT - The Externally formated ending date
; ECNUM - The Extract reference number
;
; Output
; ^TMP("ECX-PRO EXC",$J) - Array for the exception message
; ECXLNE - The number of the next line in the msg
;
S ^TMP("ECX-PRO EXC",$J,1)=" "
S ^TMP("ECX-PRO EXC",$J,2)="The DSS-Prosthetic Extract #"_ECNUM_" for "_ECXEBDT_" through "_ECXEEDT
S ^TMP("ECX-PRO EXC",$J,3)="has completed. The following is a list of Prosthetics records that were NOT"
S ^TMP("ECX-PRO EXC",$J,4)="extracted due to missing information in the Record of Pros Appliance/Repair"
S ^TMP("ECX-PRO EXC",$J,5)="file (#660). The Prosthetics record may be reviewed and the missing"
S ^TMP("ECX-PRO EXC",$J,6)="information completed. Once the missing information has been entered, it"
S ^TMP("ECX-PRO EXC",$J,7)="will be necessary to re-generate the Prosthetics Extract for the above noted"
S ^TMP("ECX-PRO EXC",$J,8)="date range."
S ^TMP("ECX-PRO EXC",$J,9)=" "
S ^TMP("ECX-PRO EXC",$J,10)="If you do not intend to transmit Prosthetics Extract #"_ECNUM_", then please"
S ^TMP("ECX-PRO EXC",$J,11)="purge it before generating a new extract for the same date range."
S ^TMP("ECX-PRO EXC",$J,12)=" "
S ^TMP("ECX-PRO EXC",$J,13)=" "
S ^TMP("ECX-PRO EXC",$J,14)=" PROSTHETICS FILE (#660) MISSING DATA"
S ^TMP("ECX-PRO EXC",$J,15)=" IEN ELEMENTS"
S ^TMP("ECX-PRO EXC",$J,16)=" "
S ECXLNE=15
Q
;
ECXMISLN(ECXMISS,ECXLNE,ECXPIEN) ;** Report Missing Lines
N ECXPCE,ECXFIRST,ECXFIELD
S ECXFIRST=1
F ECXPCE=1:1:11 DO
.I +$P(ECXMISS,"^",ECXPCE) DO
..S ECXFIELD=$P($T(ECXFLD+ECXPCE),";;",2)
..I 'ECXFIRST S ^TMP("ECX-PRO EXC",$J,ECXLNE)=" "_ECXFIELD
..I ECXFIRST DO
...S ^TMP("ECX-PRO EXC",$J,ECXLNE)=" "_ECXPIEN_" "_ECXFIELD
...S ECXFIRST=0
..S ECXLNE=ECXLNE+1
S ^TMP("ECX-PRO EXC",$J,ECXLNE)=" "
S ECXLNE=ECXLNE+1
Q
;
ECXFLD ;* Missing Required fields
;;STATION
;;PATIENT NAME (Invalid)
;;SSN
;;NAME (In Patient file - #2)
;;DELIVERY DATE
;;TYPE OF TRANSACTION
;;SOURCE
;;HCPCS
;;REQUESTING STATION
;;FORM REQUESTED ON
;;RECEIVING STATION
Q
;
FEEDINFO(ECXSRCE,ECXHCPCS,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB) ;Get Feeder Key and Feeder Location
; Input
; ECXSTAT2 - Station Number for extract
; ECXTYPE - Type of Transaction work performed
; ECXSRCE - Source of prosthesis
; ECXHCPCS - HCPCS code for prosthesis
; ECXRQST - Requesting Station
; ECXRCST - Receiving Station
; ECXLAB - Lab or non-Lab
; Output (to be KILLed by calling routine)
; ECXFELOC - Feeder Location
; ECXFEKEY - Feeder Key
;
;* NOTE: If a Station # <> Requesting Station
;* AND
;* Station # <> Receiving Station,
;* then Feeder Location will be NULL.
;
S ECXFELOC=""
S ECXFEKEY=ECXHCPCS_$S(ECXTYPE="X":"X",1:"N")_ECXSRCE
;
;* If processing a Non-Lab Transaction
I ECXLAB="NONL" D Q
.S ECXFELOC=ECXSTAT2_"NONL"
;
;* If processing a Lab Transaction
I ECXLAB="LAB" D Q
.I ECXSTAT2=ECXRCST D
..S ECXFELOC=ECXRCST_"LAB"
..S ECXFEKEY=ECXFEKEY_ECXRQST_"REQ"
I ECXLAB="ORD" D Q
.I ECXSTAT2=ECXRQST D
..S ECXFELOC=ECXRQST_"ORD"
..S ECXFEKEY=ECXFEKEY_ECXRCST_"REC"
;
Q