PSDPATI.m

PSDPATI ;B'ham ISC/BJW - Patient/Location Inquiry ; 11 Feb 98

 ;;3.0; CONTROLLED SUBSTANCES ;**8**;13 Feb 97

 ;**Y2K compliance**,"P" added to date input string

 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)

 I '$D(^XUSEC("PSD ERROR",DUZ)) W $C(7),!!,"Contact your Pharmacy Coordinator for access to display the",!,"Patient/Location data.",!!,"PSD ERROR security key required.",! Q

PAT ;ask patient

 K DA,DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient Name: "

 D ^DIC K DIC G:Y<0 END  S DFN=+Y,PSDPAT=$P(Y,"^",2)

DATE ;ask date

 K DA,%DT S %DT="AEPT",%DT("A")="Enter Date of Stay: "

 D ^%DT K %DT G:Y<0 END S VAINDT=+Y X ^DD("DD") S PSDT=Y

INQ ;patient inquire

 D INP^VADPT W @IOF,?15,"Patient Inquiry",!!,"Patient: ",PSDPAT,!,"Date of Stay: ",PSDT,!,"Ward Location: ",$P(VAIN(4),"^",2),!,"Room-Bed: ",$P(VAIN(5),"^"),!

 D KVAR^VADPT K VA

 G PAT

END ;kills variables

 K %DT,DA,DIC,DTOUT,DUOUT,PSDT,PSDPAT,X,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDPATI   929     printed  Nov 22, 2024@16:58:06                                                                                                                                                                                                      Page 2

PSDPATI   ;B'ham ISC/BJW - Patient/Location Inquiry ; 11 Feb 98

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**8**;13 Feb 97

 +2       ;**Y2K compliance**,"P" added to date input string

 +3        IF '$DATA(PSDSITE)

               DO ^PSDSET

               if '$DATA(PSDSITE)

                   QUIT 

 +4        IF '$DATA(^XUSEC("PSD ERROR",DUZ))

               WRITE $CHAR(7),!!,"Contact your Pharmacy Coordinator for access to display the",!,"Patient/Location data.",!!,"PSD ERROR security key required.",!

               QUIT 

PAT       ;ask patient

 +1        KILL DA,DIC

           SET DIC=2

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Patient Name: "

 +2        DO ^DIC

           KILL DIC

           if Y<0

               GOTO END

           SET DFN=+Y

           SET PSDPAT=$PIECE(Y,"^",2)

DATE      ;ask date

 +1        KILL DA,%DT

           SET %DT="AEPT"

           SET %DT("A")="Enter Date of Stay: "

 +2        DO ^%DT

           KILL %DT

           if Y<0

               GOTO END

           SET VAINDT=+Y

           XECUTE ^DD("DD")

           SET PSDT=Y

INQ       ;patient inquire

 +1        DO INP^VADPT

           WRITE @IOF,?15,"Patient Inquiry",!!,"Patient: ",PSDPAT,!,"Date of Stay: ",PSDT,!,"Ward Location: ",$PIECE(VAIN(4),"^",2),!,"Room-Bed: ",$PIECE(VAIN(5),"^"),!

 +2        DO KVAR^VADPT

           KILL VA

 +3        GOTO PAT

END       ;kills variables

 +1        KILL %DT,DA,DIC,DTOUT,DUOUT,PSDT,PSDPAT,X,Y

 +2        QUIT