110 lines
2.9 KiB
Mathematica
110 lines
2.9 KiB
Mathematica
VAQDBIP8 ;ALB/JRP - CONTINUATIONS FOR VAQDBIP1;31-MAR-93
|
|
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|
SCRIPTS ;EXTRACT PRESCRIPTION INFORMATION
|
|
; DECLARATIONS TAKEN CARE OF IN VAQDBIP1
|
|
;DETERMINE CUTOFF DATE
|
|
S X1=DT,X2=-CUTOFF
|
|
D C^%DTC
|
|
S CUTDATE=X
|
|
;GET LIST OF PRESCRIPTIONS
|
|
F CUTDATE=CUTDATE:0 D Q:('CUTDATE)
|
|
.S CUTDATE=$O(^PS(55,DFN,"P","A",CUTDATE))
|
|
.Q:('CUTDATE)
|
|
.F RXIFN=0:0 D Q:('RXIFN)
|
|
..S RXIFN=$O(^PS(55,DFN,"P","A",CUTDATE,RXIFN))
|
|
..Q:('RXIFN)
|
|
..;EXTRACT PRESCRIPTION INFORMATION
|
|
..F LOOP=1:1 D Q:(ERROR)
|
|
...S TMP=$T(PROFILE+LOOP^VAQDBII1)
|
|
...I ($P(TMP,";;",2)="") S ERROR=1 Q
|
|
...S ERROR=$$XTRCT^VAQDBIP2(TMP,DFN,RXIFN,ARRAY,ENCPTR,KEY1,KEY2)
|
|
...I ERROR D Q
|
|
....S TMP=$$KILLARR^VAQUTL1(ARRAY,"VALUE")
|
|
....S TMP=$$KILLARR^VAQUTL1(ARRAY,"ID")
|
|
Q:(ERROR<0)
|
|
;CONVERT/CALCULATE INFORMATION THAT WILL NOT BE CORRECT
|
|
S SEQ=""
|
|
F S SEQ=$O(@ARRAY@("VALUE",52,.01,SEQ)) Q:(SEQ="") D RXCNVRT
|
|
S ERROR=0
|
|
Q
|
|
;
|
|
RXCNVRT ;CONVERT/CALCULATE PRESCRIPTION INFORMATION
|
|
;GET IFN OF PRESCRIPTION
|
|
S TMP=$G(@ARRAY@("VALUE",52,.01,SEQ))
|
|
Q:(TMP="")
|
|
;DECRYPT RX#
|
|
S STRING=TMP
|
|
S DECSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,.01) X DECRYPT
|
|
S TMP=DECSTR
|
|
S RXIFN=$O(^PSRX("B",TMP,""))
|
|
Q:(RXIFN="")
|
|
;GET FILL DATE (USE AS LAST FILL DATE IF HASN'T BEEN REFILLED)
|
|
S STRING=$G(@ARRAY@("VALUE",52,22,SEQ))
|
|
;DECRYPT
|
|
S DECSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,22) X DECRYPT
|
|
;CALCULATE LAST FILL DATE
|
|
S J=0,RX3=""
|
|
F S J=$O(^PSRX(RXIFN,1,J)) Q:('J) S RX3=+^PSRX(RXIFN,1,J,0)
|
|
S Y=RX3
|
|
I (Y'="") D DD^%DT S STRING=Y
|
|
I (Y="") S STRING=DECSTR
|
|
;ENCRYPT INFORMATION
|
|
S ENCSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,101) X ENCRYPT
|
|
S @ARRAY@("VALUE",52,101,SEQ)=ENCSTR
|
|
;CALCULATE STATUS (RX3 ALREADY DEFINED)
|
|
S J=RXIFN
|
|
S RX0=$G(^PSRX(RXIFN,0))
|
|
S RX2=$G(^PSRX(RXIFN,2))
|
|
D STAT^PSOEXDT
|
|
;ENCRYPT INFORMATION
|
|
S STRING=$G(ST)
|
|
S ENCSTR=STRING
|
|
I (ENCSTR'="") I $$NCRPFLD^VAQUTL2(52,100) X ENCRYPT
|
|
S @ARRAY@("VALUE",52,100,SEQ)=ENCSTR
|
|
;CONVERT SIG TO NON-ABBREVIATION FORMAT
|
|
S STRING=$G(@ARRAY@("VALUE",52,10,SEQ))
|
|
;DECRYPT INFORMATION
|
|
S DECSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,10) X DECRYPT
|
|
S TMP=DECSTR
|
|
I (TMP'="") D
|
|
.S J=""
|
|
.F LOOP=1:1:$L(TMP," ") S X=$P(TMP," ",LOOP) D:(X'="")
|
|
..S Y=$G(^PS(51,"A",X))
|
|
..S X1=$P(Y,"^",1)
|
|
..S X2=$P(Y,"^",2)
|
|
..S:(X1="") X1=X
|
|
..I (X2'="") D
|
|
...S X=+$P(TMP," ",(LOOP-1))
|
|
...S:(X>1) X1=X2
|
|
..I (J="") S J=X1 Q
|
|
..S J=J_" "_X1
|
|
.S TMP=J
|
|
;ENCRYPT INFORMATION
|
|
S STRING=TMP
|
|
S ENCSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,10) X ENCRYPT
|
|
S @ARRAY@("VALUE",52,10,SEQ)=ENCSTR
|
|
;CONVERT DRUG NAME TO NATION DRUG NAME (IF AVAILABLE)
|
|
S STRING=$G(@ARRAY@("VALUE",52,6,SEQ))
|
|
;DECRYPT INFORMATION
|
|
S DECSTR=STRING
|
|
I $$NCRPFLD^VAQUTL2(52,6) X DECRYPT
|
|
S TMP=DECSTR
|
|
I (TMP'="") D
|
|
.S J=$O(^PSDRUG("B",TMP,""))
|
|
.Q:(J="")
|
|
.S TMP=+$G(^PSDRUG(J,"ND"))
|
|
.Q:('TMP)
|
|
.S J=$P($G(^PSNDF(TMP,0)),"^")
|
|
.Q:(J="")
|
|
.;ENCRYPT INFORMATION
|
|
.S STRING=J
|
|
.S ENCSTR=STRING
|
|
.I $$NCRPFLD^VAQUTL2(52,6) X ENCRYPT
|
|
.S @ARRAY@("VALUE",52,6,SEQ)=ENCSTR
|
|
Q
|