source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT8.m@ 724

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PPPPRT8 ;ALB/DMB - FFX PRINT 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 ;
5PRTFAC(PATDFN) ; Entry point for pharmacy
6 ;
7 N TMP,VISITS
8 S VISITS=$$GETVIS^PPPGET7(PATDFN,"^TMP(""PPP"",$J,""VIS"")")
9 I $D(^TMP("PPP",$J,"VIS")) S TMP=$$POF(PATDFN,"^TMP(""PPP"",$J,""VIS"")")
10 K ^TMP("PPP",$J,"VIS")
11 Q
12 ;
13POF(PATDFN,TARRY) ; Print Other Facilities
14 ;
15 ; This function takes the data contained in TARRY and writes
16 ; it to standard out.
17 ;
18 N DIC,DR,DA,DIQ,DUOUT,DTOUT,U,PARMERR,PATNAME,PATDOB,PATSSN,PPPTMP
19 N STANAME,LINEDATA,PDXDATA
20 ;
21 S PARMERR=-9001
22 S U="^"
23 ;
24 I $G(PATDFN)<1 Q PARMERR
25 I '$D(@TARRY) Q PARMERR
26 ;
27 ; Get the local name, SSN and DOB
28 ;
29 S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
30 S PATNAME=PPPTMP(2,PATDFN,.01)
31 S PATDOB=$$E2IDT^PPPCNV1(PPPTMP(2,PATDFN,.03))
32 S PATSSN=PPPTMP(2,PATDFN,.09)
33 K PPPTMP,DIC,DR,DA,DTOUT,DUOUT
34 ;
35 ; Write out the header
36 ;
37 W !,"Visits to other facilities are on file for ==>"
38 W !,?5,PATNAME," (",$E(PATSSN,1,3),"-",$E(PATSSN,4,5),"-",$E(PATSSN,6,9),") Born ",$$I2EDT^PPPCNV1(PATDOB)
39 W !!,"Station",?21,"Last PDX",?33,"PDX Status",?60,"Pharmacy Data"
40 W ! F I=1:1:IOM W "="
41 ;
42 ; Now order through the array and print the info.
43 ;
44 S STANAME=""
45 F S STANAME=$O(@TARRY@(STANAME)) Q:STANAME="" D
46 .S LINEDATA=@TARRY@(STANAME,2)
47 .W !,$E($P(LINEDATA,U),1,18)
48 .W ?21,$S(+$P(LINEDATA,U,2)'<0:$P(LINEDATA,U,2),1:"UNKNOWN")
49 .W ?33,$P(LINEDATA,U,3),?60,$P(LINEDATA,U,4)
50 .I @TARRY@(STANAME,0)>0 D
51 ..S PDXDATA=@TARRY@(STANAME,1)
52 ..I PATNAME'=$P(PDXDATA,U,1) D
53 ...W !," Warning... PDX Name (",$P(PDXDATA,U,1),") Does Not Equal Local Name."
54 ..I PATDOB'=$P(PDXDATA,U,2) D
55 ...W !," Warning... PDX DOB (",$$I2EDT^PPPCNV1($P(PDXDATA,U,2)),") Does Not Equal Local DOB."
56 Q 0
Note: See TracBrowser for help on using the repository browser.