| 1 | DGPMBSR2 ;ALB/LM - COLLECT REMAINING TOTALS FOR BED STATUS; 16 JAN 91
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | A I $S('$D(RD):1,'RD:1,1:0) Q
|
|---|
| 5 | S VAPRT=$S('$D(VAPRT):0,1:VAPRT),VACN=$S($D(VACN):VACN,1:0),X1=RD,X2=1 D C^%DTC S VATD=9999999.999999-X
|
|---|
| 6 | D PR,FR,O65,VN
|
|---|
| 7 | ;
|
|---|
| 8 | Q K CN,D,DB,DGSF,DGVT,DV,M,MW,MW1,MW2,MW2,P,PR,PR1,PRC,PRT,R,T,W,X,X1,X2,XX,XX1,XX2,XX3 D KVAR^VADPT30 Q
|
|---|
| 9 | ;
|
|---|
| 10 | PR ; Patient's Remaining [Required]
|
|---|
| 11 | I REM S DV=+DIV,VAPRC=1,DFN=0 F PR=0:0 S DFN=$O(^DGPM("C",DFN)) Q:'DFN S VABO=0 D VAR^VADPT30,BOS:VABO
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | FR ; Females Remaining [Required]
|
|---|
| 15 | S (VAPRC,DFN)=0
|
|---|
| 16 | F PR=0:0 S DFN=$O(^DPT("ASX","F",DFN)) Q:'DFN I $O(^DGPM("ATID1",DFN,9999998-RD)) D VAR^VADPT30 D FR1
|
|---|
| 17 | Q
|
|---|
| 18 | FR1 I VAWD S DV=+DIV D DV:'DV
|
|---|
| 19 | S:VAWD ^(+VAWD)=$S($D(^UTILITY("DGFR",$J,+VAWD)):^(+VAWD),1:0)+1
|
|---|
| 20 | S:VATS ^(+VATS)=$S($D(^UTILITY("DGTF",$J,DV,+VATS)):^(+VATS),1:0)+1
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | O65 ; Over 65 years old Remaining [Optional]
|
|---|
| 24 | Q:'SF
|
|---|
| 25 | S DGSF=RD\1-650000,(VAPRC,DB)=0
|
|---|
| 26 | F PR=0:0 S DB=$O(^DPT("ADOB",DB)),DFN=0 Q:'DB!(DB>(DT-650000)) F PR1=0:0 S DFN=$O(^DPT("ADOB",DB,DFN)) Q:'DFN I $O(^DGPM("ATID1",DFN,9999998-RD)) D VAR^VADPT30 D O651
|
|---|
| 27 | Q
|
|---|
| 28 | O651 I VAWD S DV=+DIV D DV:'DV
|
|---|
| 29 | S:VAWD ^(+VAWD)=$S($D(^UTILITY("DG6",$J,+VAWD)):^(+VAWD),1:0)+1
|
|---|
| 30 | S:VATS ^(+VATS)=$S($D(^UTILITY("DGT6",$J,DV,+VATS)):^(+VATS),1:0)+1
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | VN ; Vietnam Veteran's Remaining [Optional]
|
|---|
| 34 | Q:'VN
|
|---|
| 35 | S DGVT=$O(^DIC(21,"D",7,0)) Q:'DGVT
|
|---|
| 36 | S (VAPRC,DFN)=0
|
|---|
| 37 | F PR=0:0 S DFN=$O(^DPT("APOS",DGVT,DFN)) Q:'DFN I $O(^DGPM("ATID1",DFN,9999998-RD)) D VAR^VADPT30 D VN1
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | VN1 I VAWD S DV=+DIV D DV:'DV
|
|---|
| 41 | S:VAWD ^(+VAWD)=$S($D(^UTILITY("DGVN",$J,+VAWD)):^(+VAWD),1:0)+1
|
|---|
| 42 | S:VATS ^(+VATS)=$S($D(^UTILITY("DGTV",$J,DV,+VATS)):^(+VATS),1:0)+1
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | BOS ; Bed Occupant Status
|
|---|
| 46 | S:$D(DGPMBO(VABO)) ^DIBT(+DGPMY,1,VAMV)=""
|
|---|
| 47 | Q:VAPRT
|
|---|
| 48 | S DV=+DIV D DV:'DV
|
|---|
| 49 | S:VAWD X="DG"_$S(VABO=1:"PS",VABO=2:"AA",VABO=3:"UA",1:"IP")
|
|---|
| 50 | S:VAWD ^(+VAWD)=$S($D(^UTILITY(X,$J,+VAWD)):^(+VAWD),1:0)+1
|
|---|
| 51 | S:VATS X1="DGT"_$S(VABO=1:"O",VABO=2:"A",VABO=3:"U",1:"I")
|
|---|
| 52 | S:VATS ^(+VATS)=$S($D(^UTILITY(X1,$J,DV,+VATS)):^(+VATS),1:0)+1
|
|---|
| 53 | Q:VABO'=1
|
|---|
| 54 | S:VAWD ^(+VAWD)=$S($D(^UTILITY("DGIP",$J,+VAWD)):^(+VAWD),1:0)+1
|
|---|
| 55 | S:VATS ^(+VATS)=$S($D(^UTILITY("DGTI",$J,+DV,+VATS)):^(+VATS),1:0)+1
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | DV S DV=$S($D(^DIC(42,+VAWD,0)):+$P(^(0),"^",11),1:0) S:'DV DV=+DIV Q
|
|---|
| 59 | ;
|
|---|
| 60 | UTIL ; Utility Nodes
|
|---|
| 61 | ; DGAA=Authorized Absence ;
|
|---|
| 62 | ; DGUA=Unauthorized Absence ;
|
|---|
| 63 | ; DGPS=Pass ;
|
|---|
| 64 | ; DGIP=Inpatient (BO) ;
|
|---|
| 65 | ; DGVN=Vietnam ;
|
|---|
| 66 | ; DGFR=Female Remaining ;
|
|---|
| 67 | ; DG6=Over 65 ;
|
|---|
| 68 | ; DGTP=Treating Speciality Pass ;
|
|---|
| 69 | ; DGTI=Treating Speciality Inpatient ;
|
|---|
| 70 | ; DGTU=Treating Speciality UA ;
|
|---|
| 71 | ; DGTA=Treating Speciality AA ;
|
|---|
| 72 | ; DGTV=Treating Speciality Vietnam ;
|
|---|
| 73 | ; DGT6=Treating Speciality +65 ;
|
|---|
| 74 | ; DGTF=Treating Speciality Female ;
|
|---|
