| 1 | PPPDSP4 ;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 | ;
|
|---|
| 8 | POF(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 | ;
|
|---|
| 28 | HDR ; -- 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 | ;
|
|---|
| 34 | INIT ; -- 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 | ;
|
|---|
| 66 | FNL ; -- Clean Up
|
|---|
| 67 | ;
|
|---|
| 68 | K @LSTARRY
|
|---|
| 69 | K PATNAME,PATDOB
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | SETL ; -- Sets up list manager diplay array
|
|---|
| 73 | S VALMCNT=VALMCNT+1
|
|---|
| 74 | S @LSTARRY@(VALMCNT,0)=$E(TXTLINE,1,79)
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | OTH ; -- 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 | ;
|
|---|
| 83 | BOTH ; -- 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 | ;
|
|---|
| 89 | END ; -- End of code
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
