- YSDGDEM0 ;ALB/ASF,ALB/XAK-Patient Demographic Lookup (cont.) ;4/4/90 08:34 ;08/12/93 15:33
- ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
- ;
- ; Called by routine YSDGDEM
- A ;
- S DFN=YSDFN D IN5^VADPT,INP^VADPT W !!,"Inpatient Status: " I VAIP(1)="" W "Not admitted" G SA
- LOSS ;
- S (YSADM,YSADM(0),L,YSTRN,YSTRN(0),DIS)=0,YSNOW=$P($H,",",2)\60,YSNOW=YSNOW\60*100+(YSNOW#60)+1/10000+DT
- YSADM ;
- S YSADM=VAIN(1),YSADMDT=$P(VAIN(7),U) G INP:YSADM'>0 S (YSTRN,YSTRN(0),DIS)=0
- G YSADM:YSADMDT>YSNOW!(YSADMDT<YSADM(0)) S YSADM(0)=^DGPM(YSADM,0)
- L I VAIN(4)]"" S L=$P(VAIN(4),U)
- YSTRN ;
- S YSTRN=VAIP(1),YSTRNDT=$P(VAIP(4),U) G YSADM:YSTRN="",YSTRN:YSTRNDT<YSTRN(0)!(YSTRNDT)>YSNOW S YSTRN(0)=^DGPM(YSTRN,0) I VAIP(5)]"" S L=$P(VAIP(5),U)
- INP ;
- G DIS:'L W "Active",!,"Admitted: ",$P(VAIN(7),U,2),?30,"Ward: ",$P(VAIN(4),U,2)," -"
- I $P(YSTRN(0),U,2)<6!($P(YSTRN(0),U,2)>9) W "On ward Bed: ",$P(VAIP(6),U,2)
- E W "Absent Due: " W:VAIP(11)]"" $P(VAIP(11),U,2)
- I $D(^DPT("AS","S",YSDFN)) W !?26,"Seriously Ill"
- G SA
- DIS ;
- S X1=$P(VAIP(17,1),U),X2=$P(VAIP(13),U) D ^%DTC
- W "Inactive",?28,"Discharged: ",$P(VAIP(17,1),U,2)," Type: ",$P(VAIP(17,4),U,2),?72,"LOS: ",X
- SA ;
- I $D(^DIC(42,"ARSV",YSDFN)) S X=$O(^(YSDFN,0)) I X,$D(^DIC(42,X,"RSV",YSDFN,0)),$P(^(0),U,2)'<DT S L=$P(^(0),U,2) W !?18,"Scheduled Admission on ward ",$P(^DIC(42,X,0),U)," on ",$E(L,4,5),"/",$E(L,6,7),"/",$E(L,2,3)
- CL ;
- G YSFA:'$O(^DPT(YSDFN,"DE",0)) W !!,"Currently enrolled in " S I=0 F S I=$O(^DPT(YSDFN,"DE",I)) Q:'I I $D(^(I,0)),$P(^(0),U,2)'="I" W:$X>60 !?22 W $S($D(^SC(+^(0),0)):$P(^(0),U)_", ",1:"")
- ;
- YSFA ;
- S YSCT=0 W !!,"Future Appointments: " I '$O(^DPT(YSDFN,"S",DT)) W "NONE" G RMK
- W ?22,"Date",?34,"Time",?42,"Clinic",!?22 F I=22:1:75 W "="
- F YSFA=DT:0 S YSFA=$O(^DPT(YSDFN,"S",YSFA)) G RMK:'YSFA S L=^(YSFA,0),C=+L I $P(L,U,2)'["C" D YSCOV,YSCOV1 Q:YSCT>5
- I $O(^DPT(YSDFN,"S",YSFA)) W !,"See Scheduling options for additional appointments."
- RMK ;
- W !!,"Remarks: ",$P(PTI(0),U,10) I $D(^DPT(YSDFN,.35)),^(.35)]"" W " PATIENT HAS DIED."
- K Y,YSADM,YSTRN,DIS,YSSSN,YSFA,C,L,YSCOV,YSNOW,YSCT,PTI D WAIT^YSUTL Q
- YSCOV ;
- S YSCOV=$S($P(L,U,7)=7:" (Collateral) ",1:""),YSCT=YSCT+1 Q
- YSCOV1 ;
- S YSFDT=$$FMTE^XLFDT(YSFA,"5P")
- W !?22,$P(YSFDT," "),?34,$P(YSFDT," ",2),?42,$P($S($D(^SC(C,0)):^(0),1:""),U)," ",YSCOV Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDGDEM0 2343 printed Jan 18, 2025@03:15:17 Page 2
- YSDGDEM0 ;ALB/ASF,ALB/XAK-Patient Demographic Lookup (cont.) ;4/4/90 08:34 ;08/12/93 15:33
- +1 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
- +2 ;
- +3 ; Called by routine YSDGDEM
- A ;
- +1 SET DFN=YSDFN
- DO IN5^VADPT
- DO INP^VADPT
- WRITE !!,"Inpatient Status: "
- IF VAIP(1)=""
- WRITE "Not admitted"
- GOTO SA
- LOSS ;
- +1 SET (YSADM,YSADM(0),L,YSTRN,YSTRN(0),DIS)=0
- SET YSNOW=$PIECE($HOROLOG,",",2)\60
- SET YSNOW=YSNOW\60*100+(YSNOW#60)+1/10000+DT
- YSADM ;
- +1 SET YSADM=VAIN(1)
- SET YSADMDT=$PIECE(VAIN(7),U)
- if YSADM'>0
- GOTO INP
- SET (YSTRN,YSTRN(0),DIS)=0
- +2 if YSADMDT>YSNOW!(YSADMDT<YSADM(0))
- GOTO YSADM
- SET YSADM(0)=^DGPM(YSADM,0)
- L IF VAIN(4)]""
- SET L=$PIECE(VAIN(4),U)
- YSTRN ;
- +1 SET YSTRN=VAIP(1)
- SET YSTRNDT=$PIECE(VAIP(4),U)
- if YSTRN=""
- GOTO YSADM
- if YSTRNDT<YSTRN(0)!(YSTRNDT)>YSNOW
- GOTO YSTRN
- SET YSTRN(0)=^DGPM(YSTRN,0)
- IF VAIP(5)]""
- SET L=$PIECE(VAIP(5),U)
- INP ;
- +1 if 'L
- GOTO DIS
- WRITE "Active",!,"Admitted: ",$PIECE(VAIN(7),U,2),?30,"Ward: ",$PIECE(VAIN(4),U,2)," -"
- +2 IF $PIECE(YSTRN(0),U,2)<6!($PIECE(YSTRN(0),U,2)>9)
- WRITE "On ward Bed: ",$PIECE(VAIP(6),U,2)
- +3 IF '$TEST
- WRITE "Absent Due: "
- if VAIP(11)]""
- WRITE $PIECE(VAIP(11),U,2)
- +4 IF $DATA(^DPT("AS","S",YSDFN))
- WRITE !?26,"Seriously Ill"
- +5 GOTO SA
- DIS ;
- +1 SET X1=$PIECE(VAIP(17,1),U)
- SET X2=$PIECE(VAIP(13),U)
- DO ^%DTC
- +2 WRITE "Inactive",?28,"Discharged: ",$PIECE(VAIP(17,1),U,2)," Type: ",$PIECE(VAIP(17,4),U,2),?72,"LOS: ",X
- SA ;
- +1 IF $DATA(^DIC(42,"ARSV",YSDFN))
- SET X=$ORDER(^(YSDFN,0))
- IF X
- IF $DATA(^DIC(42,X,"RSV",YSDFN,0))
- IF $PIECE(^(0),U,2)'<DT
- SET L=$PIECE(^(0),U,2)
- WRITE !?18,"Scheduled Admission on ward ",$PIECE(^DIC(42,X,0),U)," on ",$EXTRACT(L,4,5),"/",$EXTRACT(L,6,7),"/",$EXTRACT(L,2,3)
- CL ;
- +1 if '$ORDER(^DPT(YSDFN,"DE",0))
- GOTO YSFA
- WRITE !!,"Currently enrolled in "
- SET I=0
- FOR
- SET I=$ORDER(^DPT(YSDFN,"DE",I))
- if 'I
- QUIT
- IF $DATA(^(I,0))
- IF $PIECE(^(0),U,2)'="I"
- if $X>60
- WRITE !?22
- WRITE $SELECT($DATA(^SC(+^(0),0)):$PIECE(^(0),U)_", ",1:"")
- +2 ;
- YSFA ;
- +1 SET YSCT=0
- WRITE !!,"Future Appointments: "
- IF '$ORDER(^DPT(YSDFN,"S",DT))
- WRITE "NONE"
- GOTO RMK
- +2 WRITE ?22,"Date",?34,"Time",?42,"Clinic",!?22
- FOR I=22:1:75
- WRITE "="
- +3 FOR YSFA=DT:0
- SET YSFA=$ORDER(^DPT(YSDFN,"S",YSFA))
- if 'YSFA
- GOTO RMK
- SET L=^(YSFA,0)
- SET C=+L
- IF $PIECE(L,U,2)'["C"
- DO YSCOV
- DO YSCOV1
- if YSCT>5
- QUIT
- +4 IF $ORDER(^DPT(YSDFN,"S",YSFA))
- WRITE !,"See Scheduling options for additional appointments."
- RMK ;
- +1 WRITE !!,"Remarks: ",$PIECE(PTI(0),U,10)
- IF $DATA(^DPT(YSDFN,.35))
- IF ^(.35)]""
- WRITE " PATIENT HAS DIED."
- +2 KILL Y,YSADM,YSTRN,DIS,YSSSN,YSFA,C,L,YSCOV,YSNOW,YSCT,PTI
- DO WAIT^YSUTL
- QUIT
- YSCOV ;
- +1 SET YSCOV=$SELECT($PIECE(L,U,7)=7:" (Collateral) ",1:"")
- SET YSCT=YSCT+1
- QUIT
- YSCOV1 ;
- +1 SET YSFDT=$$FMTE^XLFDT(YSFA,"5P")
- +2 WRITE !?22,$PIECE(YSFDT," "),?34,$PIECE(YSFDT," ",2),?42,$PIECE($SELECT($DATA(^SC(C,0)):^(0),1:""),U)," ",YSCOV
- QUIT