DGWAIT ;ALB/JDS - ENTER PATIENTS INTO WAIT LIST; 21 APR 84 13:57
;;5.3;Registration;;Aug 13, 1993
;
DIV K DIE("NO^"),DIC W !! S DGWAIT=1,DIC="^DGWAIT(",DIC(0)="AEQMZL" D ^DIC K DIC G Q:Y'>0 S DIV=+Y
;
PAT K DIC,DIE,DE,DQ W !! S:'($D(^DGWAIT(DIV,"P",0))\10) ^DGWAIT(DIV,"P",0)="^42.51PA^^" S DA(1)=DIV,DIC="^DGWAIT("_DIV_",""P"",",DIC(0)="AEQMZL" D ^DIC G DIV:Y'>0
EDIT S DIE=DIC,DGI=DA(1),(DGI1,DA)=+Y,DR=$P($T(T),";;",2,999),DP=42.51 D ^DIE K DR I '$D(DA) W !!,"Patient Deleted from Waiting List",*7 K DGI,DGI1 G PAT:DGWAIT,Q
S DGD=^DGWAIT(DGI,"P",DGI1,0),DGER=0
S DGF="^DATE/TIME OF APPLICATION^^ACTION^BEDSECTION APPLYING TO^IN ANOTHER HOSPITAL^VA FACILITY^HOSPITAL NAME^PRIORITY GROUPING^TREATING SPECIALTY^^HOSPITAL/NHCU APPLICATION^CATEGORY OF NEED"
I $P(DGD,"^",2)'["." S X=2,X1="does not include time..." D W
F X=12,5,10,4,9 I $P(DGD,"^",X)']"" S X1="is not specified..." D W
I $P(DGD,"^",12)="h",$P(DGD,"^",13)']"" S X=13,X1="not specified for HOSPITAL applicant..." D W
S X=$P(DGD,"^",12) I X]"",$P(DGD,"^",9)]"",$D(^DIC(42.55,+$P(DGD,"^",9),0)),$P(^(0),"^",5)'=X,$P(^(0),"^",5)'="a" S X=9,X1="inconsistent with "_$S($P(DGD,"^",12)="h":"Hospital",1:"NHCU")_" application..." D W
G CD:'$P(DGD,"^",6) F X=7,8 I $P(DGD,"^",X)']"" S X1="must be specified if currently hospitalized..." D W
CD I 'DGER W !!,"Patient Entered on Waiting List" G PAT:DGWAIT,Q
W !!,"Above inconsistencies must be corrected before continuing.",! S DA(1)=DGI,Y=DGI1 G EDIT
;
Q K DGER,DR,DIE,DGI,DGI1,DA,DIC,DGD,DGF,X,X1,DIV,DGWAIT Q
DIVK K DIE("NO^"),DIC W !! S DIC("A")="Delete WAITING LIST entry from which DIVISION: ",DIC="^DGWAIT(",DIC(0)="AEQMZ" D ^DIC K DIC G Q:Y'>0 S DIV=+Y
PATK K DIC,DIE,DE,DQ W !! S DIC("A")="Delete WAITING LIST entry for which patient: ",DA(1)=DIV,DIC="^DGWAIT("_DIV_",""P"",",DIC(0)="AEQMZ" D ^DIC G DIVK:Y'>0 S DA=+Y
OKD S %=2 W !,"OK to delete ",$P(^DPT(+^DGWAIT(DIV,"P",DA,0),0),"^",1)," WAITING LIST entry" D YN^DICN I '% W !,"ANSWER 'Y'ES OR 'N'O" G OKD
I %=1 S DIK=DIC,DA(1)=DIV D ^DIK W !,"*DELETED*" G Q
G Q
W W:'DGER ! W !," > ",$P(DGF,"^",X)," ",X1 S DGER=1 Q
T ;;S DIE("NO^")="",DFN=+^DGWAIT(DA(1),"P",DA,0);S SC=$S('$D(^DPT(DFN,.3)):0,$P(^(.3),"^",1)="Y":1,1:0);.01;2//NOW;12//HOSPITAL;I X'="h" S Y=1;13//GENERAL;1;1.5;3.5;I 'X S Y=4;3.6;3.7;4//PENDING;3///^S X=SC;K SC;5;K DIE("NO^");10;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGWAIT 2352 printed Apr 09, 2024@22:00:02 Page 2
DGWAIT ;ALB/JDS - ENTER PATIENTS INTO WAIT LIST; 21 APR 84 13:57
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
DIV KILL DIE("NO^"),DIC
WRITE !!
SET DGWAIT=1
SET DIC="^DGWAIT("
SET DIC(0)="AEQMZL"
DO ^DIC
KILL DIC
if Y'>0
GOTO Q
SET DIV=+Y
+1 ;
PAT KILL DIC,DIE,DE,DQ
WRITE !!
if '($DATA(^DGWAIT(DIV,"P",0))\10)
SET ^DGWAIT(DIV,"P",0)="^42.51PA^^"
SET DA(1)=DIV
SET DIC="^DGWAIT("_DIV_",""P"","
SET DIC(0)="AEQMZL"
DO ^DIC
if Y'>0
GOTO DIV
EDIT SET DIE=DIC
SET DGI=DA(1)
SET (DGI1,DA)=+Y
SET DR=$PIECE($TEXT(T),";;",2,999)
SET DP=42.51
DO ^DIE
KILL DR
IF '$DATA(DA)
WRITE !!,"Patient Deleted from Waiting List",*7
KILL DGI,DGI1
if DGWAIT
GOTO PAT
GOTO Q
+1 SET DGD=^DGWAIT(DGI,"P",DGI1,0)
SET DGER=0
+2 SET DGF="^DATE/TIME OF APPLICATION^^ACTION^BEDSECTION APPLYING TO^IN ANOTHER HOSPITAL^VA FACILITY^HOSPITAL NAME^PRIORITY GROUPING^TREATING SPECIALTY^^HOSPITAL/NHCU APPLICATION^CATEGORY OF NEED"
+3 IF $PIECE(DGD,"^",2)'["."
SET X=2
SET X1="does not include time..."
DO W
+4 FOR X=12,5,10,4,9
IF $PIECE(DGD,"^",X)']""
SET X1="is not specified..."
DO W
+5 IF $PIECE(DGD,"^",12)="h"
IF $PIECE(DGD,"^",13)']""
SET X=13
SET X1="not specified for HOSPITAL applicant..."
DO W
+6 SET X=$PIECE(DGD,"^",12)
IF X]""
IF $PIECE(DGD,"^",9)]""
IF $DATA(^DIC(42.55,+$PIECE(DGD,"^",9),0))
IF $PIECE(^(0),"^",5)'=X
IF $PIECE(^(0),"^",5)'="a"
SET X=9
SET X1="inconsistent with "_$SELECT($PIECE(DGD,"^",12)="h":"Hospital",1:"NHCU")_" application..."
DO W
+7 if '$PIECE(DGD,"^",6)
GOTO CD
FOR X=7,8
IF $PIECE(DGD,"^",X)']""
SET X1="must be specified if currently hospitalized..."
DO W
CD IF 'DGER
WRITE !!,"Patient Entered on Waiting List"
if DGWAIT
GOTO PAT
GOTO Q
+1 WRITE !!,"Above inconsistencies must be corrected before continuing.",!
SET DA(1)=DGI
SET Y=DGI1
GOTO EDIT
+2 ;
Q KILL DGER,DR,DIE,DGI,DGI1,DA,DIC,DGD,DGF,X,X1,DIV,DGWAIT
QUIT
DIVK KILL DIE("NO^"),DIC
WRITE !!
SET DIC("A")="Delete WAITING LIST entry from which DIVISION: "
SET DIC="^DGWAIT("
SET DIC(0)="AEQMZ"
DO ^DIC
KILL DIC
if Y'>0
GOTO Q
SET DIV=+Y
PATK KILL DIC,DIE,DE,DQ
WRITE !!
SET DIC("A")="Delete WAITING LIST entry for which patient: "
SET DA(1)=DIV
SET DIC="^DGWAIT("_DIV_",""P"","
SET DIC(0)="AEQMZ"
DO ^DIC
if Y'>0
GOTO DIVK
SET DA=+Y
OKD SET %=2
WRITE !,"OK to delete ",$PIECE(^DPT(+^DGWAIT(DIV,"P",DA,0),0),"^",1)," WAITING LIST entry"
DO YN^DICN
IF '%
WRITE !,"ANSWER 'Y'ES OR 'N'O"
GOTO OKD
+1 IF %=1
SET DIK=DIC
SET DA(1)=DIV
DO ^DIK
WRITE !,"*DELETED*"
GOTO Q
+2 GOTO Q
W if 'DGER
WRITE !
WRITE !," > ",$PIECE(DGF,"^",X)," ",X1
SET DGER=1
QUIT
T ;;S DIE("NO^")="",DFN=+^DGWAIT(DA(1),"P",DA,0);S SC=$S('$D(^DPT(DFN,.3)):0,$P(^(.3),"^",1)="Y":1,1:0);.01;2//NOW;12//HOSPITAL;I X'="h" S Y=1;13//GENERAL;1;1.5;3.5;I 'X S Y=4;3.6;3.7;4//PENDING;3///^S X=SC;K SC;5;K DIE("NO^");10;
