| 1 | PPPPRT8 ;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 | ;
|
|---|
| 5 | PRTFAC(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 | ;
|
|---|
| 13 | POF(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
|
|---|
