source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPDSP4.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: 2.6 KB
RevLine 
[613]1PPPDSP4 ;ALB/JFP - PRINT OTHER FACLITIES ROUTINES ; 5/14/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; These routines control the display of other facilities
6 ; via the list processor.
7 ;
8POF(PATDFN,TARRY) ; Print Other Facilities
9 ;
10 ; This is the main entry point for calling the list processor.
11 ; PATDFN - The patient internal entry number
12 ; TARRY - This function takes the data contained in TARRY and
13 ; formats it for display in the list processor.
14 ;
15 N DIC,DR,DA,DIQ,DUOUT,DTOUT,U,PARMERR,PATSSN,PPPTMP
16 N STANAME,LINEDATA,PDXDATA,LSTARRY
17 ;
18 S PARMERR=-9001
19 S U="^"
20 ;
21 I $G(PATDFN)<1 Q PARMERR
22 I '$D(@TARRY) Q PARMERR
23 ;
24 K XQORS,VALMEVL
25 D EN^VALM("PPP VISITS")
26 Q 0
27 ;
28HDR ; -- Writes out the header.
29 ;
30 S VALMHDR(1)=""
31 S VALMHDR(2)="Patient: "_PATNAME_" ("_$E(PATSSN,1,3)_"-"_$E(PATSSN,4,5)_"-"_$E(PATSSN,6,9)_") DOB: "_$$I2EDT^PPPCNV1(PATDOB)
32 Q
33 ;
34INIT ; -- Sets display array from data array
35 ; Now order through the array and print the info.
36 ;
37 N TXTLINE
38 ;
39 S LSTARRY="^TMP(""PPPL3"",$J)" K @LSTARRY
40 ;
41 S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
42 S PATNAME=PPPTMP(2,PATDFN,.01)
43 S PATDOB=$$E2IDT^PPPCNV1(PPPTMP(2,PATDFN,.03))
44 S PATSSN=PPPTMP(2,PATDFN,.09)
45 K PPPTMP,DIC,DR,DA,DTOUT,DUOUT
46 ;
47 S VALMCNT=0
48 S (TXTLINE,STANAME)=""
49 F S STANAME=$O(@TARRY@(STANAME)) Q:STANAME="" D
50 .S LINEDATA=$G(@TARRY@(STANAME,2))
51 .S TXTLINE=$$SETFLD^VALM1($E($P(LINEDATA,U),1,18),TXTLINE,"STATION")
52 .S TXTLINE=$$SETFLD^VALM1($S(+$P(LINEDATA,U,2)'<0:$P(LINEDATA,U,2),1:"UNKNOWN"),TXTLINE,"LASTPDX")
53 .S TXTLINE=$$SETFLD^VALM1($P(LINEDATA,U,3),TXTLINE,"STATUS")
54 .S TXTLINE=$$SETFLD^VALM1($P(LINEDATA,U,4),TXTLINE,"PHDATA")
55 .D SETL
56 .I @TARRY@(STANAME,0)>0 D
57 ..S PDXDATA=@TARRY@(STANAME,1)
58 ..I PATNAME'=$P(PDXDATA,U,1) D
59 ...S TXTLINE=" Warning... PDX Name ("_$P(PDXDATA,U,1)_") Does Not Equal Local Name."
60 ...D SETL
61 ..I PATDOB'=$P(PDXDATA,U,2) D
62 ...S TXTLINE=" Warning... PDX DOB ("_$$I2EDT^PPPCNV1($P(PDXDATA,U,2))_") Does Not Equal Local DOB."
63 ...D SETL
64 Q
65 ;
66FNL ; -- Clean Up
67 ;
68 K @LSTARRY
69 K PATNAME,PATDOB
70 Q
71 ;
72SETL ; -- Sets up list manager diplay array
73 S VALMCNT=VALMCNT+1
74 S @LSTARRY@(VALMCNT,0)=$E(TXTLINE,1,79)
75 Q
76 ;
77OTH ; -- Diplays other facilities only
78 W !!,"Collecting Pharmacy Data...Please Wait!"
79 D DSPMED^PPPDSP3(PATDFN,TARRY,"O")
80 S TMP=$$STATUPDT^PPPMSC1(9,1)
81 Q
82 ;
83BOTH ; -- Displays both other facilities and local facility
84 W !!,"Collecting Pharmacy Data...Please Wait!"
85 D DSPMED^PPPDSP3(PATDFN,TARRY,"B")
86 S TMP=$$STATUPDT^PPPMSC1(9,1)
87 Q
88 ;
89END ; -- End of code
90 Q
91 ;
Note: See TracBrowser for help on using the repository browser.