PSJMP ;BIR/CML3-PATIENT LOOK-UP ;12 JAN 94 / 2:00 PM
;;5.0; INPATIENT MEDICATIONS ;**53,111**;16 DEC 97
;
; Reference to ^VADPT is supported by DBIA 10061
;
ENDPT ;*** get patient ***
K DIC,PSGP,Y W !!,"Select "_$S($D(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: " R X:DTIME I "^"[X S (Y,PSGP)=-1 G DONE
D EN^PSJDPT
I Y'>0 G ENDPT
K DIC
;
CHK ;*** Check patient status ***
S PPN=$P(Y,U,2),(DFN,PSGP)=+Y,VA200=1 D INP^VADPT
I VAIN(4) S PSJPWD=+VAIN(4) G DONE
;S PSJPCAF="",VAIP("D")="L" D IN5^VADPT I 'VAIP(13,1) W $C(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED." G ENDPT
S PSJPCAF="",VAIP("D")="L" D IN5^VADPT I 'VAIP(13,1) W $C(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED." G:'$$CONT ENDPT S PSJPWD="OTHER"
;S PSJPAD=VAIP(13,1),PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSGOD=$$ENDTC^PSGMI(PSGID) W $C(7),!!?3,"PATIENT IS FOUND TO BE D",$P("ISCHARG^ECEAS",U,X+1),"ED AS OF ",PSGOD,"." G:'$D(PSGRETF) ENDPT
S PSJPAD=VAIP(13,1),PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSGOD=$$ENDTC^PSGMI(PSGID) D G:'$$CONT ENDPT S PSJPWD="OTHER"
. W $C(7),!!?3,"PATIENT IS FOUND TO BE D",$P("ISCHARG^ECEAS",U,X+1),"ED AS OF ",PSGOD,"."
;
DONE ;
K DA,DIC,NB,ND,NS,PSGID,PSGOD,VA200,VADM,VAIN,VAIP,VAMT,X,Y(0),Y(0,0) Q
;
CONT() ;
K DIR S DIR("?")="A 'YES' or 'NO' response is required" W !
S DIR(0)="Y",DIR("A")="Do you wish to continue with this patient" D ^DIR
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMP 1388 printed Nov 22, 2024@17:17:50 Page 2
PSJMP ;BIR/CML3-PATIENT LOOK-UP ;12 JAN 94 / 2:00 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**53,111**;16 DEC 97
+2 ;
+3 ; Reference to ^VADPT is supported by DBIA 10061
+4 ;
ENDPT ;*** get patient ***
+1 KILL DIC,PSGP,Y
WRITE !!,"Select "_$SELECT($DATA(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: "
READ X:DTIME
IF "^"[X
SET (Y,PSGP)=-1
GOTO DONE
+2 DO EN^PSJDPT
+3 IF Y'>0
GOTO ENDPT
+4 KILL DIC
+5 ;
CHK ;*** Check patient status ***
+1 SET PPN=$PIECE(Y,U,2)
SET (DFN,PSGP)=+Y
SET VA200=1
DO INP^VADPT
+2 IF VAIN(4)
SET PSJPWD=+VAIN(4)
GOTO DONE
+3 ;S PSJPCAF="",VAIP("D")="L" D IN5^VADPT I 'VAIP(13,1) W $C(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED." G ENDPT
+4 SET PSJPCAF=""
SET VAIP("D")="L"
DO IN5^VADPT
IF 'VAIP(13,1)
WRITE $CHAR(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED."
if '$$CONT
GOTO ENDPT
SET PSJPWD="OTHER"
+5 ;S PSJPAD=VAIP(13,1),PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSGOD=$$ENDTC^PSGMI(PSGID) W $C(7),!!?3,"PATIENT IS FOUND TO BE D",$P("ISCHARG^ECEAS",U,X+1),"ED AS OF ",PSGOD,"." G:'$D(PSGRETF) ENDPT
+6 SET PSJPAD=VAIP(13,1)
SET PSGID=+VAIP(3)
SET X=+VAIP(4)=12!(+VAIP(4)=38)
SET PSGOD=$$ENDTC^PSGMI(PSGID)
Begin DoDot:1
+7 WRITE $CHAR(7),!!?3,"PATIENT IS FOUND TO BE D",$PIECE("ISCHARG^ECEAS",U,X+1),"ED AS OF ",PSGOD,"."
End DoDot:1
if '$$CONT
GOTO ENDPT
SET PSJPWD="OTHER"
+8 ;
DONE ;
+1 KILL DA,DIC,NB,ND,NS,PSGID,PSGOD,VA200,VADM,VAIN,VAIP,VAMT,X,Y(0),Y(0,0)
QUIT
+2 ;
CONT() ;
+1 KILL DIR
SET DIR("?")="A 'YES' or 'NO' response is required"
WRITE !
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue with this patient"
DO ^DIR
+3 QUIT Y
