AQAOPAR ; IHS/ORDC/LJF - ADD ENTRY TO QI PARAMETER FILE ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains 2 entry points; one for adding a new facility entry
;to the QI Parameter file and the other for editing the RPMS linkages
;for each facility.
;
SITE ; >>> ask user for facility name
W !! K DIC S DIC="^AUTTLOC(",DIC(0)="AEMZQ"
S DIC("A")="Select QI FACILITY NAME: " D ^DIC
G EXIT:$D(DTOUT),EXIT:$D(DUOUT),EXIT:X="",SITE:Y=-1 S AQAOFAC=+Y
I $D(^AQAGP(AQAOFAC)) D G SITE
.W !!,"This facility is ALREADY set up in the QI Parameter file!!"
;
SURE ; >>> ask user if he is sure he wants to add this facility
W !! K DIR,DIC S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="Okay to ADD this facility to the QI PARAMETER file"
S DIR("?",1)="Answer YES to create an entry in the QI Parameter file"
S DIR("?",2)="for the facility you selected. Answer NO to select "
S DIR("?")="another facility."
D ^DIR G EXIT:$D(DIRUT),SITE:Y=0
;
ADD ; >>> set variables and call file^dicn
W !! K DD,DO,DIC,DIR S DLAYGO=9002166,DIC="^AQAGP(",DIC(0)="L"
S (DINUM,X)=AQAOFAC,DIC("DR")="[AQAO PARAM ADD]"
L +(^AQAGP(0)):1 I '$T D G EXIT
.W !!,"CANNOT ADD; ANOTHER USER ADDING TO THIS FILE. TRY AGAIN.",!
D FILE^DICN L -(^AQAGP(0))
W !!,"CREATING ENTRY . . ."
I Y=-1 W !!,"**ERROR** COULD NOT CREATE ENTRY IN FILE!" G EXIT
W !!,"ENTRY CREATED!"
W !!,"To ACTIVATE any of the automatic linkages, please use the option"
W !,"titled EDIT PARAMETER LINKAGES and select the same facility."
W !! G SITE
;
EXIT ; >>> eoj
I $D(AQAOFAC) L -^AQAGP(AQAOFAC)
D KILL^AQAOUTIL K ^UTILITY("DIQ1",$J)
Q
;
;
EDIT ;ENTRY POINT for editing of qi parameter file
;called by option AQAO PKG PARAMETER LINK
;
I $D(AQAOFAC) L -^AQAGP(AQAOFAC)
W !! K DIC S DIC="^AQAGP(",DIC(0)="AEMZQ"
S DIC("A")="Select QI PARAMETER FACILITY: " D ^DIC
G EXIT:$D(DTOUT),EXIT:$D(DUOUT),EXIT:X="",MENU:Y=-1 S AQAOFAC=+Y
L +^AQAGP(AQAOFAC):1 I '$T D G EDIT
.W !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN.",!
;
K DIC,DIR S DIR(0)="LO^1:8^K:X#1 X"
S DIR("A")="Choose ONE or MORE to Edit"
S AQAOC=0 F I=1001:10:1071 D
.S X=$P(^AQAGP(AQAOFAC,"ADT"),U,+$E(I,3,4)),AQAOC=AQAOC+1 ;status/cnt
.S DIR("A",AQAOC)=AQAOC_") "_$P(^DD(9002166.4,I,0),U)
.S Y=50-$L(DIR("A",AQAOC)),Z="",$P(Z," ",Y)=""
.S DIR("A",AQAOC)=" "_DIR("A",AQAOC)_Z_$S(X=1:"[ON]",1:"[OFF]")
S DIR("A",AQAOC+1)=" "
D ^DIR G MENU:$D(DIRUT),MENU:Y=-1 S AQAORNG=Y
;
LOOP ; >>> loop thru links chosen and edit
S AQAOI=+AQAORNG,AQAOI=10_(AQAOI-1)_1 ;get next link
;
; >> print status of link
W !!!,"Current status of ",$P(^DD(9002166.4,AQAOI,0),U),": "
K ^UTILITY("DIQ1",$J)
S DIC=9002166.4,DA=AQAOFAC,DR="" F I=0,1,3 S DR=DR_(AQAOI+I)_";"
D EN^DIQ1 W ^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI)
W !?11,"INDICATOR: "
W $S(^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI+1)="":"<NONE DEFINED>",1:^(AQAOI+1))
W ?40,"OKAY TO DUPLICATE ON SAME DAY: "
W ^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI+3)
;
IND ; >> indicator edit
W !! K DIR S DIR(0)="F^7:7",DIR("A")=$P(^DD(9002166.4,AQAOI+1,0),U)
S DIR("?")="Enter INDICATOR #; Must be 7 characters long."
S DIR("??")="^D INDQUES^AQAOPAR"
S DIR("B")=$P(^AQAGP(AQAOFAC,"ADT"),U,+$E(AQAOI+1,3,4))
K:DIR("B")="" DIR("B") D ^DIR
G MENU:$D(DTOUT),RESET:$D(DUOUT)
I '$D(^AQAO(2,"B",Y)) W !!,*7,"INDICATOR DOES NOT EXIST IN FILE!" G IND
S Z=$O(^AQAO(2,"B",Y,0))
I Z="" W !!,*7,"INDICATOR DOES NOT EXIST IN FILE!" G IND
I $P(^AQAO(2,Z,0),U,6)'="A" W !!,*7,"INDICATOR INACTIVE!" G IND
K DIE S DIE="^AQAGP(",DA=AQAOFAC,DR=(AQAOI+1)_"////"_Y D ^DIE
;
DUPOKAY ; >> ask user if dup entry okay for linkage
K DIE,DIC S DIE="^AQAGP(",DA=AQAOFAC,DR=(AQAOI+3)_";"_AQAOI
D ^DIE
;
SERVICES ; >> link services to this linkage
I $P(^AQAGP(AQAOFAC,"ADT"),U,$E(AQAOI,3,4))=1 D CURRENT^AQAOPAR1
;
RESET ; >> reset to remaining links selected
S AQAORNG=$P(AQAORNG,",",2,99)
G MENU1:+AQAORNG=0 ;end of loop
G LOOP ;otherwise continue looping thru range selected
;
;
INDQUES ;ENTRY POINT called by xecute help on indicator fields
S DIC="^AQAO(2,",DIC(0)="EMZQ",D="B",DZ="??"
D DQ^DICQ
Q
;
;
DUPQUES ;ENTRY POINT called by xecute help on dupl okay? fields
W !!?5,"Answer YES to allow a duplicate event on the same day to "
W !?5,"create another occurrence; Answer NO to allow only ONE event"
W !?5,"per day to be entered as an occurrence.",!!
Q
;
;
LNKQUES ;ENTRY POINT called by xecute help on link fields
W !!?5,"Answer ON to turn on the link;"
W !?5,"Answer OFF to turn off the link.",!!
Q
;
;
RICU ;ENTRY POINT called by xecute help on Return to ICU-# of days field
W !!,"Enter the number of days between stays in ICU that you want"
W !,"to track. FOr example, to track all returns to ICU within 72"
W !,"hours, enter 3 for three days.",!!
Q
AQAOPAR ; IHS/ORDC/LJF - ADD ENTRY TO QI PARAMETER FILE ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains 2 entry points; one for adding a new facility entry
+4 ;to the QI Parameter file and the other for editing the RPMS linkages
+5 ;for each facility.
+6 ;
SITE ; >>> ask user for facility name
+1 WRITE !!
KILL DIC
SET DIC="^AUTTLOC("
SET DIC(0)="AEMZQ"
+2 SET DIC("A")="Select QI FACILITY NAME: "
DO ^DIC
+3 IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO EXIT
IF X=""
GOTO EXIT
IF Y=-1
GOTO SITE
SET AQAOFAC=+Y
+4 IF $DATA(^AQAGP(AQAOFAC))
Begin DoDot:1
+5 WRITE !!,"This facility is ALREADY set up in the QI Parameter file!!"
End DoDot:1
GOTO SITE
+6 ;
SURE ; >>> ask user if he is sure he wants to add this facility
+1 WRITE !!
KILL DIR,DIC
SET DIR(0)="YO"
SET DIR("B")="NO"
+2 SET DIR("A")="Okay to ADD this facility to the QI PARAMETER file"
+3 SET DIR("?",1)="Answer YES to create an entry in the QI Parameter file"
+4 SET DIR("?",2)="for the facility you selected. Answer NO to select "
+5 SET DIR("?")="another facility."
+6 DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
IF Y=0
GOTO SITE
+7 ;
ADD ; >>> set variables and call file^dicn
+1 WRITE !!
KILL DD,DO,DIC,DIR
SET DLAYGO=9002166
SET DIC="^AQAGP("
SET DIC(0)="L"
+2 SET (DINUM,X)=AQAOFAC
SET DIC("DR")="[AQAO PARAM ADD]"
+3 LOCK +(^AQAGP(0)):1
IF '$TEST
Begin DoDot:1
+4 WRITE !!,"CANNOT ADD; ANOTHER USER ADDING TO THIS FILE. TRY AGAIN.",!
End DoDot:1
GOTO EXIT
+5 DO FILE^DICN
LOCK -(^AQAGP(0))
+6 WRITE !!,"CREATING ENTRY . . ."
+7 IF Y=-1
WRITE !!,"**ERROR** COULD NOT CREATE ENTRY IN FILE!"
GOTO EXIT
+8 WRITE !!,"ENTRY CREATED!"
+9 WRITE !!,"To ACTIVATE any of the automatic linkages, please use the option"
+10 WRITE !,"titled EDIT PARAMETER LINKAGES and select the same facility."
+11 WRITE !!
GOTO SITE
+12 ;
EXIT ; >>> eoj
+1 IF $DATA(AQAOFAC)
LOCK -^AQAGP(AQAOFAC)
+2 DO KILL^AQAOUTIL
KILL ^UTILITY("DIQ1",$JOB)
+3 QUIT
+4 ;
+5 ;
EDIT ;ENTRY POINT for editing of qi parameter file
+1 ;called by option AQAO PKG PARAMETER LINK
+2 ;
+1 IF $DATA(AQAOFAC)
LOCK -^AQAGP(AQAOFAC)
+2 WRITE !!
KILL DIC
SET DIC="^AQAGP("
SET DIC(0)="AEMZQ"
+3 SET DIC("A")="Select QI PARAMETER FACILITY: "
DO ^DIC
+4 IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO EXIT
IF X=""
GOTO EXIT
IF Y=-1
GOTO MENU
SET AQAOFAC=+Y
+5 LOCK +^AQAGP(AQAOFAC):1
IF '$TEST
Begin DoDot:1
+6 WRITE !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN.",!
End DoDot:1
GOTO EDIT
+7 ;
+1 KILL DIC,DIR
SET DIR(0)="LO^1:8^K:X#1 X"
+2 SET DIR("A")="Choose ONE or MORE to Edit"
+3 SET AQAOC=0
FOR I=1001:10:1071
Begin DoDot:1
+4 ;status/cnt
SET X=$PIECE(^AQAGP(AQAOFAC,"ADT"),U,+$EXTRACT(I,3,4))
SET AQAOC=AQAOC+1
+5 SET DIR("A",AQAOC)=AQAOC_") "_$PIECE(^DD(9002166.4,I,0),U)
+6 SET Y=50-$LENGTH(DIR("A",AQAOC))
SET Z=""
SET $PIECE(Z," ",Y)=""
+7 SET DIR("A",AQAOC)=" "_DIR("A",AQAOC)_Z_$SELECT(X=1:"[ON]",1:"[OFF]")
End DoDot:1
+8 SET DIR("A",AQAOC+1)=" "
+9 DO ^DIR
IF $DATA(DIRUT)
GOTO MENU
IF Y=-1
GOTO MENU
SET AQAORNG=Y
+10 ;
LOOP ; >>> loop thru links chosen and edit
+1 ;get next link
SET AQAOI=+AQAORNG
SET AQAOI=10_(AQAOI-1)_1
+2 ;
+3 ; >> print status of link
+4 WRITE !!!,"Current status of ",$PIECE(^DD(9002166.4,AQAOI,0),U),": "
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 SET DIC=9002166.4
SET DA=AQAOFAC
SET DR=""
FOR I=0,1,3
SET DR=DR_(AQAOI+I)_";"
+7 DO EN^DIQ1
WRITE ^UTILITY("DIQ1",$JOB,9002166.4,AQAOFAC,AQAOI)
+8 WRITE !?11,"INDICATOR: "
+9 WRITE $SELECT(^UTILITY("DIQ1",$JOB,9002166.4,AQAOFAC,AQAOI+1)="":"<NONE DEFINED>",1:^(AQAOI+1))
+10 WRITE ?40,"OKAY TO DUPLICATE ON SAME DAY: "
+11 WRITE ^UTILITY("DIQ1",$JOB,9002166.4,AQAOFAC,AQAOI+3)
+12 ;
IND ; >> indicator edit
+1 WRITE !!
KILL DIR
SET DIR(0)="F^7:7"
SET DIR("A")=$PIECE(^DD(9002166.4,AQAOI+1,0),U)
+2 SET DIR("?")="Enter INDICATOR #; Must be 7 characters long."
+3 SET DIR("??")="^D INDQUES^AQAOPAR"
+4 SET DIR("B")=$PIECE(^AQAGP(AQAOFAC,"ADT"),U,+$EXTRACT(AQAOI+1,3,4))
+5 IF DIR("B")=""
KILL DIR("B")
DO ^DIR
+6 IF $DATA(DTOUT)
GOTO MENU
IF $DATA(DUOUT)
GOTO RESET
+7 IF '$DATA(^AQAO(2,"B",Y))
WRITE !!,*7,"INDICATOR DOES NOT EXIST IN FILE!"
GOTO IND
+8 SET Z=$ORDER(^AQAO(2,"B",Y,0))
+9 IF Z=""
WRITE !!,*7,"INDICATOR DOES NOT EXIST IN FILE!"
GOTO IND
+10 IF $PIECE(^AQAO(2,Z,0),U,6)'="A"
WRITE !!,*7,"INDICATOR INACTIVE!"
GOTO IND
+11 KILL DIE
SET DIE="^AQAGP("
SET DA=AQAOFAC
SET DR=(AQAOI+1)_"////"_Y
DO ^DIE
+12 ;
DUPOKAY ; >> ask user if dup entry okay for linkage
+1 KILL DIE,DIC
SET DIE="^AQAGP("
SET DA=AQAOFAC
SET DR=(AQAOI+3)_";"_AQAOI
+2 DO ^DIE
+3 ;
SERVICES ; >> link services to this linkage
+1 IF $PIECE(^AQAGP(AQAOFAC,"ADT"),U,$EXTRACT(AQAOI,3,4))=1
DO CURRENT^AQAOPAR1
+2 ;
RESET ; >> reset to remaining links selected
+1 SET AQAORNG=$PIECE(AQAORNG,",",2,99)
+2 ;end of loop
IF +AQAORNG=0
GOTO MENU1
+3 ;otherwise continue looping thru range selected
GOTO LOOP
+4 ;
+5 ;
INDQUES ;ENTRY POINT called by xecute help on indicator fields
+1 SET DIC="^AQAO(2,"
SET DIC(0)="EMZQ"
SET D="B"
SET DZ="??"
+2 DO DQ^DICQ
+3 QUIT
+4 ;
+5 ;
DUPQUES ;ENTRY POINT called by xecute help on dupl okay? fields
+1 WRITE !!?5,"Answer YES to allow a duplicate event on the same day to "
+2 WRITE !?5,"create another occurrence; Answer NO to allow only ONE event"
+3 WRITE !?5,"per day to be entered as an occurrence.",!!
+4 QUIT
+5 ;
+6 ;
LNKQUES ;ENTRY POINT called by xecute help on link fields
+1 WRITE !!?5,"Answer ON to turn on the link;"
+2 WRITE !?5,"Answer OFF to turn off the link.",!!
+3 QUIT
+4 ;
+5 ;
RICU ;ENTRY POINT called by xecute help on Return to ICU-# of days field
+1 WRITE !!,"Enter the number of days between stays in ICU that you want"
+2 WRITE !,"to track. FOr example, to track all returns to ICU within 72"
+3 WRITE !,"hours, enter 3 for three days.",!!
+4 QUIT
