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