QACUTL0 ;WCIOFO/ERC/VAD - Utility for Patient Rep reports ;29 Dec 98
;;2.0;Patient Representative;**10,9,17**;07/25/1995
;
DATDIV ;
D DATE Q:QAQPOP
D DIV Q:QAQPOP
Q
;
DATE ;select date range for Patient Rep
S QAQPOP=0
W !!,"Select the date range you want to print."
D ^QAQDATE I QAQQUIT S QAQPOP=1 Q
I QAQNBEG>DT W !,"*** Beginning date must be today or earlier! ***",$C(7) G DATE
Q
;
DIV ;select Patient Rep division
K QAC1DIV,QACDV,QACDVSN
S QAQPOP=0
S QACDV=1 ;with patch 17 division always enabled
;
N DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="YA"
S DIR("A")="Select ALL Divisions? "
S DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S QAQPOP=1 Q
I Y S QAC1DIV="" Q
N DIC,QACX
S DIC="^DIC(4,"
S DIC(0)="AEMZQ"
S DIC("A")="Enter Division: "
S DIC("S")="I $D(^DG(40.8,""AD"",+Y))"
S QACX=$$SITE^VASITE
S QACDVSN=$P(QACX,U,2)
S DIC("B")=$G(QACDVSN)
D ^DIC K DIC
I +Y>0 S QAC1DIV=+Y Q
Q
;
TASK ;set variables for call to ^%ZTLOAD
S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=""
S ZTSAVE("QAQ2HED")=""
S (ZTSAVE("QACDIV"),ZTSAVE("QAC1DIV"))=""
S (ZTSAVE("QACTEXT"),ZTSAVE("QACDESC"))=""
D ^%ZTLOAD
I $G(ZTSK) W !,"Task Number: ",ZTSK
Q
INST(QACIEN,QACDV) ;uses FileMan for name of a division from the Institution file (#4)
N DIC,X,Y
K QACDV
S DIC="^DIC(4,"
S DIC(0)="NZX"
S X=QACIEN
D ^DIC K DIC
I Y<0 S QACDV="Unknown" Q
S QACDV=Y(0,0)
Q
SITE(QACIEN,QACSIT) ;uses FM for node 99 of Inst file (#4)
N DA,DIC,DIQ,DR
K QACSIT,QACSITE
S DIC="^DIC(4,"
S DA=QACIEN
S DR=99
S DIQ="QACSITE"
D EN^DIQ1
S QACSIT=QACSITE(4,QACIEN,99)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQACUTL0 1626 printed Feb 10, 2021@20:59:15 Page 2
QACUTL0 ;WCIOFO/ERC/VAD - Utility for Patient Rep reports ;29 Dec 98
+1 ;;2.0;Patient Representative;**10,9,17**;07/25/1995
+2 ;
DATDIV ;
+1 DO DATE
if QAQPOP
QUIT
+2 DO DIV
if QAQPOP
QUIT
+3 QUIT
+4 ;
DATE ;select date range for Patient Rep
+1 SET QAQPOP=0
+2 WRITE !!,"Select the date range you want to print."
+3 DO ^QAQDATE
IF QAQQUIT
SET QAQPOP=1
QUIT
+4 IF QAQNBEG>DT
WRITE !,"*** Beginning date must be today or earlier! ***",$CHAR(7)
GOTO DATE
+5 QUIT
+6 ;
DIV ;select Patient Rep division
+1 KILL QAC1DIV,QACDV,QACDVSN
+2 SET QAQPOP=0
+3 ;with patch 17 division always enabled
SET QACDV=1
+4 ;
+5 NEW DIR,DIRUT,DTOUT,DUOUT
+6 SET DIR(0)="YA"
+7 SET DIR("A")="Select ALL Divisions? "
+8 SET DIR("B")="YES"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET QAQPOP=1
QUIT
+10 IF Y
SET QAC1DIV=""
QUIT
+11 NEW DIC,QACX
+12 SET DIC="^DIC(4,"
+13 SET DIC(0)="AEMZQ"
+14 SET DIC("A")="Enter Division: "
+15 SET DIC("S")="I $D(^DG(40.8,""AD"",+Y))"
+16 SET QACX=$$SITE^VASITE
+17 SET QACDVSN=$PIECE(QACX,U,2)
+18 SET DIC("B")=$GET(QACDVSN)
+19 DO ^DIC
KILL DIC
+20 IF +Y>0
SET QAC1DIV=+Y
QUIT
+21 QUIT
+22 ;
TASK ;set variables for call to ^%ZTLOAD
+1 SET (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=""
+2 SET ZTSAVE("QAQ2HED")=""
+3 SET (ZTSAVE("QACDIV"),ZTSAVE("QAC1DIV"))=""
+4 SET (ZTSAVE("QACTEXT"),ZTSAVE("QACDESC"))=""
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
WRITE !,"Task Number: ",ZTSK
+7 QUIT
INST(QACIEN,QACDV) ;uses FileMan for name of a division from the Institution file (#4)
+1 NEW DIC,X,Y
+2 KILL QACDV
+3 SET DIC="^DIC(4,"
+4 SET DIC(0)="NZX"
+5 SET X=QACIEN
+6 DO ^DIC
KILL DIC
+7 IF Y<0
SET QACDV="Unknown"
QUIT
+8 SET QACDV=Y(0,0)
+9 QUIT
SITE(QACIEN,QACSIT) ;uses FM for node 99 of Inst file (#4)
+1 NEW DA,DIC,DIQ,DR
+2 KILL QACSIT,QACSITE
+3 SET DIC="^DIC(4,"
+4 SET DA=QACIEN
+5 SET DR=99
+6 SET DIQ="QACSITE"
+7 DO EN^DIQ1
+8 SET QACSIT=QACSITE(4,QACIEN,99)
+9 QUIT
