- 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
- 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
