source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP8.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.9 KB
RevLine 
[613]1VAQDBIP8 ;ALB/JRP - CONTINUATIONS FOR VAQDBIP1;31-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3SCRIPTS ;EXTRACT PRESCRIPTION INFORMATION
4 ; DECLARATIONS TAKEN CARE OF IN VAQDBIP1
5 ;DETERMINE CUTOFF DATE
6 S X1=DT,X2=-CUTOFF
7 D C^%DTC
8 S CUTDATE=X
9 ;GET LIST OF PRESCRIPTIONS
10 F CUTDATE=CUTDATE:0 D Q:('CUTDATE)
11 .S CUTDATE=$O(^PS(55,DFN,"P","A",CUTDATE))
12 .Q:('CUTDATE)
13 .F RXIFN=0:0 D Q:('RXIFN)
14 ..S RXIFN=$O(^PS(55,DFN,"P","A",CUTDATE,RXIFN))
15 ..Q:('RXIFN)
16 ..;EXTRACT PRESCRIPTION INFORMATION
17 ..F LOOP=1:1 D Q:(ERROR)
18 ...S TMP=$T(PROFILE+LOOP^VAQDBII1)
19 ...I ($P(TMP,";;",2)="") S ERROR=1 Q
20 ...S ERROR=$$XTRCT^VAQDBIP2(TMP,DFN,RXIFN,ARRAY,ENCPTR,KEY1,KEY2)
21 ...I ERROR D Q
22 ....S TMP=$$KILLARR^VAQUTL1(ARRAY,"VALUE")
23 ....S TMP=$$KILLARR^VAQUTL1(ARRAY,"ID")
24 Q:(ERROR<0)
25 ;CONVERT/CALCULATE INFORMATION THAT WILL NOT BE CORRECT
26 S SEQ=""
27 F S SEQ=$O(@ARRAY@("VALUE",52,.01,SEQ)) Q:(SEQ="") D RXCNVRT
28 S ERROR=0
29 Q
30 ;
31RXCNVRT ;CONVERT/CALCULATE PRESCRIPTION INFORMATION
32 ;GET IFN OF PRESCRIPTION
33 S TMP=$G(@ARRAY@("VALUE",52,.01,SEQ))
34 Q:(TMP="")
35 ;DECRYPT RX#
36 S STRING=TMP
37 S DECSTR=STRING
38 I $$NCRPFLD^VAQUTL2(52,.01) X DECRYPT
39 S TMP=DECSTR
40 S RXIFN=$O(^PSRX("B",TMP,""))
41 Q:(RXIFN="")
42 ;GET FILL DATE (USE AS LAST FILL DATE IF HASN'T BEEN REFILLED)
43 S STRING=$G(@ARRAY@("VALUE",52,22,SEQ))
44 ;DECRYPT
45 S DECSTR=STRING
46 I $$NCRPFLD^VAQUTL2(52,22) X DECRYPT
47 ;CALCULATE LAST FILL DATE
48 S J=0,RX3=""
49 F S J=$O(^PSRX(RXIFN,1,J)) Q:('J) S RX3=+^PSRX(RXIFN,1,J,0)
50 S Y=RX3
51 I (Y'="") D DD^%DT S STRING=Y
52 I (Y="") S STRING=DECSTR
53 ;ENCRYPT INFORMATION
54 S ENCSTR=STRING
55 I $$NCRPFLD^VAQUTL2(52,101) X ENCRYPT
56 S @ARRAY@("VALUE",52,101,SEQ)=ENCSTR
57 ;CALCULATE STATUS (RX3 ALREADY DEFINED)
58 S J=RXIFN
59 S RX0=$G(^PSRX(RXIFN,0))
60 S RX2=$G(^PSRX(RXIFN,2))
61 D STAT^PSOEXDT
62 ;ENCRYPT INFORMATION
63 S STRING=$G(ST)
64 S ENCSTR=STRING
65 I (ENCSTR'="") I $$NCRPFLD^VAQUTL2(52,100) X ENCRYPT
66 S @ARRAY@("VALUE",52,100,SEQ)=ENCSTR
67 ;CONVERT SIG TO NON-ABBREVIATION FORMAT
68 S STRING=$G(@ARRAY@("VALUE",52,10,SEQ))
69 ;DECRYPT INFORMATION
70 S DECSTR=STRING
71 I $$NCRPFLD^VAQUTL2(52,10) X DECRYPT
72 S TMP=DECSTR
73 I (TMP'="") D
74 .S J=""
75 .F LOOP=1:1:$L(TMP," ") S X=$P(TMP," ",LOOP) D:(X'="")
76 ..S Y=$G(^PS(51,"A",X))
77 ..S X1=$P(Y,"^",1)
78 ..S X2=$P(Y,"^",2)
79 ..S:(X1="") X1=X
80 ..I (X2'="") D
81 ...S X=+$P(TMP," ",(LOOP-1))
82 ...S:(X>1) X1=X2
83 ..I (J="") S J=X1 Q
84 ..S J=J_" "_X1
85 .S TMP=J
86 ;ENCRYPT INFORMATION
87 S STRING=TMP
88 S ENCSTR=STRING
89 I $$NCRPFLD^VAQUTL2(52,10) X ENCRYPT
90 S @ARRAY@("VALUE",52,10,SEQ)=ENCSTR
91 ;CONVERT DRUG NAME TO NATION DRUG NAME (IF AVAILABLE)
92 S STRING=$G(@ARRAY@("VALUE",52,6,SEQ))
93 ;DECRYPT INFORMATION
94 S DECSTR=STRING
95 I $$NCRPFLD^VAQUTL2(52,6) X DECRYPT
96 S TMP=DECSTR
97 I (TMP'="") D
98 .S J=$O(^PSDRUG("B",TMP,""))
99 .Q:(J="")
100 .S TMP=+$G(^PSDRUG(J,"ND"))
101 .Q:('TMP)
102 .S J=$P($G(^PSNDF(TMP,0)),"^")
103 .Q:(J="")
104 .;ENCRYPT INFORMATION
105 .S STRING=J
106 .S ENCSTR=STRING
107 .I $$NCRPFLD^VAQUTL2(52,6) X ENCRYPT
108 .S @ARRAY@("VALUE",52,6,SEQ)=ENCSTR
109 Q
Note: See TracBrowser for help on using the repository browser.