BZXLREDT ;IHS/PIMC/JLG - EDIT TABLES FOR AZ HEALTH DEPT REPORT [ 07/18/2002 2:22 PM ]
;;1.0;Special local routine for reportable diseases
ENTER K DIRUT
S DIC=1966360
S DIC(0)="AEQMLZ"
S DIC("A")="Enter reportable disease test: "
S DLAYGO=1966360
D ^DIC
I Y=-1!$D(DIRUT) D Q
.K DIC,DLAYGO,Y,DIROUT,DTOUT,DIRUT
I $P(Y,U,3)="" D G ENTER:$G(BZXDELTD)
.K BZXDELTD
.S DIR("A")="Would you like to delete the "_Y(0,0)_" entry"
.S DIR(0)="Y"
.S DA=+Y
.N Y
.D ^DIR
.Q:Y=0
.W !,"Deleted!"
.S BZXDELTD=Y
.S DIK=DIC
.D ^DIK
S BZXTYPE=$P(@(U_$P(^LAB(60,$P(Y,U,2),0),U,12)_"0)"),U,2)
S DIE=DIC
S DA=+Y
K DR
I $E(BZXTYPE,1)="N" D
.S DR=".03;.04"
E I BZXTYPE="S" D
.S DR="1"
E I $E(BZXTYPE,1)="F" D
.S DR="4"
S DR=DR_";2//"_Y(0,0)
D ^DIE
G ENTER
Q
BZXLREDT ;IHS/PIMC/JLG - EDIT TABLES FOR AZ HEALTH DEPT REPORT [ 07/18/2002 2:22 PM ]
+1 ;;1.0;Special local routine for reportable diseases
ENTER KILL DIRUT
+1 SET DIC=1966360
+2 SET DIC(0)="AEQMLZ"
+3 SET DIC("A")="Enter reportable disease test: "
+4 SET DLAYGO=1966360
+5 DO ^DIC
+6 IF Y=-1!$DATA(DIRUT)
Begin DoDot:1
+7 KILL DIC,DLAYGO,Y,DIROUT,DTOUT,DIRUT
End DoDot:1
QUIT
+8 IF $PIECE(Y,U,3)=""
Begin DoDot:1
+9 KILL BZXDELTD
+10 SET DIR("A")="Would you like to delete the "_Y(0,0)_" entry"
+11 SET DIR(0)="Y"
+12 SET DA=+Y
+13 NEW Y
+14 DO ^DIR
+15 IF Y=0
QUIT
+16 WRITE !,"Deleted!"
+17 SET BZXDELTD=Y
+18 SET DIK=DIC
+19 DO ^DIK
End DoDot:1
IF $GET(BZXDELTD)
GOTO ENTER
+20 SET BZXTYPE=$PIECE(@(U_$PIECE(^LAB(60,$PIECE(Y,U,2),0),U,12)_"0)"),U,2)
+21 SET DIE=DIC
+22 SET DA=+Y
+23 KILL DR
+24 IF $EXTRACT(BZXTYPE,1)="N"
Begin DoDot:1
+25 SET DR=".03;.04"
End DoDot:1
+26 IF '$TEST
IF BZXTYPE="S"
Begin DoDot:1
+27 SET DR="1"
End DoDot:1
+28 IF '$TEST
IF $EXTRACT(BZXTYPE,1)="F"
Begin DoDot:1
+29 SET DR="4"
End DoDot:1
+30 SET DR=DR_";2//"_Y(0,0)
+31 DO ^DIE
+32 GOTO ENTER
+33 QUIT
+34
***** ERRORS & WARNINGS IN BZXLREDT *****
BZXLREDT+1 S - 2nd line of routine violates the SAC.
ENTER+34 W - Null line (no commands or comment).
