- DGWAIT ;ALB/JDS - ENTER PATIENTS INTO WAIT LIST; 21 APR 84 13:57
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- 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;
- DGWAIT ;ALB/JDS - ENTER PATIENTS INTO WAIT LIST; 21 APR 84 13:57
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +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;
