source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPGET7.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1PPPGET7 ;ALB/DMB - EXTRACT UTILITIES ; 4/30/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**1,10,19**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETVIS(PATDFN,TARRY) ; Get the other visit information.
6 ;
7 ; This functions builds an array with the patient visit information
8 ; which can then pe printed or displayed to the user.
9 ; It returns a 1 if there is pharmacy data available from any
10 ; of the other facilties or a zero if not.
11 ;
12 ; The Output array looks like -->
13 ;
14 ; @TARRY@(StationName,0)=DataAvailable^PDXDataFileIFN^StationNumber
15 ; @TARRY@(StationName,1)=PatientName^DateOfBirth
16 ; @TARRY@(StationName,2)=StationName^LastPDXDate^LastPDXStatus^PharmacyDataAvailable
17 ;
18 N DATAV,IFN,PDXDATA,PDXNODE,POVNAME,POVNUM,POVPTR,U,DI,C,D0,I
19 ;
20 S U="^",DATAV=0
21 ;
22 F IFN=0:0 S IFN=$O(^PPP(1020.2,"B",PATDFN,IFN)) Q:IFN="" D
23 .;
24 .; -- Check for bad pointer
25 .I '$D(^PPP(1020.2,IFN,0)) Q
26 .;
27 .; -- Get Place Of Visit
28 .S POVPTR=+$P(^PPP(1020.2,IFN,0),U,2)
29 .S POVNAME=$$GETSTANM^PPPGET1(POVPTR)
30 .S POVNUM=(POVPTR) ;dave
31 .I POVNAME="" S POVNAME="NOT FOUND"
32 .I POVNUM<0 S POVNUM=0
33 .;
34 .; Get PDX Pointer Data
35 .;
36 .S PDXNODE=$$GETPDXND(IFN)
37 .Q:$P(PDXNODE,U,1)<1
38 .;
39 .; Get the PDX Pharmacy Data
40 .;
41 .S PDXDATA=$$PDXDAT^PPPDSP2(+PDXNODE)
42 .Q:$P(PDXDATA,U,1)<1
43 .;
44 .; Now Store the values in the array
45 .;
46 .S @TARRY@(POVNAME,0)=+$P(PDXDATA,U)_U_$P(PDXNODE,U)_U_POVNUM
47 .S @TARRY@(POVNAME,1)=$P(PDXDATA,U,2)_U_$P(PDXDATA,U,3)
48 .S @TARRY@(POVNAME,2)=POVNAME_U_$$SLASHDT^PPPCNV1($P(PDXNODE,U,3))_U_$P(PDXNODE,U,2)_U_$S(+$P(PDXDATA,U)<1:"NOT ",1:"")_"AVAILABLE"
49 .I +$P(PDXDATA,U)=1 S DATAV=1
50 ;
51 Q DATAV
52 ;
53GETPDXND(FFXIFN) ; Get the PDX node
54 ;
55 ; This function returns the data in the PDX node of the
56 ; FFX file.
57 ;
58 ; The return format is:
59 ; PDX_POINTER^STATUS_DESCRIPTION^LAST_PDX_DATE or
60 ; -1 for entry not found
61 ;
62 ; The date is returned in internal FM format.
63 ;
64 N U,PDXNODE,PDXPTR,PDXDATE,PDXSTPTR,PDXSTAT
65 ;
66 I $G(FFXIFN)="" Q -1
67 S U="^"
68 ;
69 S PDXNODE=$G(^PPP(1020.2,FFXIFN,1))
70 S PDXPTR=+$P(PDXNODE,U)
71 S PDXDATE=+$P(PDXNODE,U,2)
72 S PDXSTPTR=+$P(PDXNODE,U,3)
73 I PDXSTPTR=0 S PDXSTAT="NONE"
74 E S PDXSTAT=$P($$GETPDXST(PDXSTPTR),U,2)
75 Q PDXPTR_U_PDXSTAT_U_PDXDATE
76 ;
77GETPDXST(STATPTR) ; Get the PDX status from the status file
78 ;
79 ; This function looks up the status code and the description
80 ; from the IFN of the PDX Status File.
81 ;
82 ; The return format is:
83 ; STATUS_CODE^DESCRIPTION or
84 ; -1 for status not found or not supported
85 ;
86 Q:('(+$G(STATPTR))) "-1^Unknown"
87 N STATUS,TEXT
88 ;GET STATUS CODE
89 S STATUS=$P($G(^VAT(394.85,STATPTR,0)),"^",1)
90 Q:(STATUS="") "-1^Unknown"
91 ;DETERMINE DESCRIPTION
92 S TEXT=""
93 S:(STATUS="VAQ-AMBIG") TEXT="Patient was ambiguous"
94 S:(STATUS="VAQ-AUTO") TEXT="Processing automatically"
95 S:(STATUS="VAQ-NTFND") TEXT="Patient was not found"
96 S:(STATUS="VAQ-PROC") TEXT="Requires processing"
97 S:(STATUS="VAQ-REJ") TEXT="Information not returned"
98 S:(STATUS="VAQ-RQACK") TEXT="Request waiting for processing"
99 S:(STATUS="VAQ-RQST") TEXT="Request has been sent"
100 S:(STATUS="VAQ-RSLT") TEXT="Results received"
101 S:(STATUS="VAQ-RTRNS") TEXT="Retransmitting"
102 S:(STATUS="VAQ-TUNSL") TEXT="Unsolicited has been sent"
103 S:(STATUS="VAQ-UNACK") TEXT="Unsolicited sent/received"
104 S:(STATUS="VAQ-UNSOL") TEXT="Unsolicited PDX"
105 S:(TEXT="") STATUS="-1",TEXT="Unknown"
106 Q (STATUS_"^"_TEXT)
107 ;
108GETSTPTR(CODE) ; Get pointer to PDX status
109 ;INPUT : CODE - Code that identifies PDX status
110 ;OUTPUT : Pointer to PDX status
111 ; If status not found, returns -1
112 ;
113 ;CHECK INPUT
114 Q:($G(CODE)="") -1
115 ;DECLARE VARIABLES
116 N POINTER
117 ;GET POINTER
118 S POINTER=+$O(^VAT(394.85,"B",CODE,""))
119 Q:('POINTER) -1
120 ;VERIFY POINTER
121 Q:($P($G(^VAT(394.85,POINTER,0)),"^",1)'=CODE) -1
122 Q POINTER
Note: See TracBrowser for help on using the repository browser.