ACKQFIL ;BIR/PTD-Update A&SP Files per CO Directive ; [ 08/23/95 3:02 PM ]
;;3.0;QUASAR;**1**;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
ACCESS ; Only A&SP staff designated as supervisors can access this option.
N ACKDUZ
S ACKDUZ=$$PROVCHK^ACKQASU4(DUZ) S:ACKDUZ="" ACKDUZ=" "
W @IOF I $O(^ACK(509850.3,ACKDUZ,""))="" W !,"You are not listed in the A&SP STAFF file (#509850.3).",!,"Access denied." G EXIT
S X=$$STACT^ACKQUTL(ACKDUZ) I ((X=-2)!(X=-6)) W !,"Only clinicians may access this option!" G EXIT
I X W !,"The A&SP STAFF file (#509850.3) indicates that you have been inactivated.",!,"Access denied." G EXIT
I $P(^ACK(509850.3,ACKDUZ,0),"^",6)'=1 W !,"You must be listed as a SUPERVISOR in the A&SP STAFF file (#509850.3)",!,"in order to use this option. Access denied." G EXIT
OPTN ; Introduce option.
W !,"This option can be used to update the CDR ACCOUNT file, the",!,"A&SP PROCEDURE CODE file, or the A&SP DIAGNOSTIC CONDITION file.",!
WARN ; This option should be used only with CO directive.
W !!?20,"********** WARNING **********"
W !!?5,"This option is to be used ONLY with direction from the",!?5,"Director, Audiology and Speech Pathology Service (VAHQ).",!!?20,"*****************************",!!
SURE ; Give user opportunity to exit if unsure.
S DIR(0)="Y",DIR("A")="Are you sure you should continue",DIR("B")="NO",DIR("?")="Enter YES to continue; enter NO or press return to exit."
S DIR("??")="^D SURE^ACKQHLP1" D ^DIR K DIR I $D(DIRUT)!(Y=0) G EXIT
FILE ; Display files user can update and allow selection.
W @IOF K DIR,X,Y S DIR(0)="NAO^1:3"
S DIR("A",1)="Select the action you wish to take."
S DIR("A",2)=""
S DIR("A",3)="1. Update the CDR ACCOUNT file (#509850)."
S DIR("A",4)="2. Update the A&SP DIAGNOSTIC CONDITION file (#509850.1)."
S DIR("A",5)="3. Update the A&SP PROCEDURE CODE file (#509850.4)."
;
S DIR("A")="Enter a number 1 thru 3: "
S DIR("?")="Select a number from 1 thru 3 or press <Return> to exit"
S DIR("??")="^D FILE^ACKQHLP1" D ^DIR K DIR I $D(DIRUT)!(Y="") G EXIT
S ACKANS=+Y,ACKFNUM=509850_$S(ACKANS=3:".4",ACKANS=2:".1",1:"")
S ACKFNAM=$S(ACKANS=3:"A&SP PROCEDURE CODE",ACKANS=2:"A&SP DIAGNOSTIC CONDITION",1:"CDR ACCOUNT")
ACTION ; Display actions user can take on selected file.
W @IOF K ACKANS,DIR,X,Y S DIR(0)="NAO^1:2",DIR("A",1)="What do you want to do with the "_ACKFNAM_" file (#"_ACKFNUM_")?",DIR("A",2)="",DIR("A",3)="1. Inactivate selected entries.",DIR("A",4)="2. Add new file entries.",DIR("A",5)=""
S DIR("A")="Enter a number, 1 or 2: ",DIR("?")="Answer 1 to make an entry inactive; answer 2 to add a new entry"
S DIR("??")="^D ACTION^ACKQHLP1" D ^DIR K DIR G:$D(DIRUT) EXIT
S ACKANS=+Y W @IOF,!! D CNTR^ACKQUTL(ACKFNAM_" file (#"_ACKFNUM_")") W ! I ACKANS=2 K ACKANS,DIR,X,Y G ^ACKQFIL1
INACT ;User wants to inactivate selected entries.
S DIC="^ACK("_ACKFNUM_",",DIC(0)="QEAM",DIC("A")="Select entry to inactivate: " D ^DIC K DIC I Y<0 D EXIT G FILE
S ACKIEN=+Y
I ACKFNUM="509850.4" D LONG^ACKQUTL6(ACKIEN,"1")
S ACKPC=$S(ACKFNUM="509850.4":4,ACKFNUM="509850.1":6,1:5),ACKZNODE=^ACK(ACKFNUM,ACKIEN,0),ACKACT=$P(ACKZNODE,"^",ACKPC)
I ACKACT=1 S $P(^ACK(ACKFNUM,ACKIEN,0),"^",ACKPC)=0 W !,"This entry has been inactivated.",! D KVAR G INACT
CHANGE ;Else entry is already marked as INACTIVE.
W ! K DIR,X,Y S DIR(0)="Y",DIR("A",1)="This entry is already marked as INACTIVE.",DIR("A")="Do you want to make it ACTIVE",DIR("B")="NO",DIR("?")="Answer YES to make the entry ACTIVE; enter NO to make no change."
S DIR("??")="^D CHANGE^ACKQHLP1" D ^DIR K DIR I $D(DIRUT)!(Y=0) W !,"No change made. This entry is still inactive.",! D KVAR G INACT
;User wants to change the INACTIVE entry ACTIVE.
S $P(^ACK(ACKFNUM,ACKIEN,0),"^",ACKPC)=1 W !,"This entry has been changed to active.",! D KVAR G INACT
;
EXIT ;Kill variables and exit routine.
I $D(ACKIEN) L -^ACK(ACKFNUM,ACKIEN)
K %,ACKACT,ACKANS,ACKCOMP,ACKFNAM,ACKFNUM,ACKHRLOS,ACKIEN,ACKLAYGO,ACKMOD,ACKNEW,ACKORIG,ACKPC,ACKSUB,ACKZNODE,DA,DIC,DIE,DIK,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,PC,X,Y
Q
;
KVAR ;Kill selected variables.
K ACKACT,ACKPC,ACKZNODE,DIC,DIR,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQFIL 4210 printed Apr 09, 2024@21:34:16 Page 2
ACKQFIL ;BIR/PTD-Update A&SP Files per CO Directive ; [ 08/23/95 3:02 PM ]
+1 ;;3.0;QUASAR;**1**;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
ACCESS ; Only A&SP staff designated as supervisors can access this option.
+1 NEW ACKDUZ
+2 SET ACKDUZ=$$PROVCHK^ACKQASU4(DUZ)
if ACKDUZ=""
SET ACKDUZ=" "
+3 WRITE @IOF
IF $ORDER(^ACK(509850.3,ACKDUZ,""))=""
WRITE !,"You are not listed in the A&SP STAFF file (#509850.3).",!,"Access denied."
GOTO EXIT
+4 SET X=$$STACT^ACKQUTL(ACKDUZ)
IF ((X=-2)!(X=-6))
WRITE !,"Only clinicians may access this option!"
GOTO EXIT
+5 IF X
WRITE !,"The A&SP STAFF file (#509850.3) indicates that you have been inactivated.",!,"Access denied."
GOTO EXIT
+6 IF $PIECE(^ACK(509850.3,ACKDUZ,0),"^",6)'=1
WRITE !,"You must be listed as a SUPERVISOR in the A&SP STAFF file (#509850.3)",!,"in order to use this option. Access denied."
GOTO EXIT
OPTN ; Introduce option.
+1 WRITE !,"This option can be used to update the CDR ACCOUNT file, the",!,"A&SP PROCEDURE CODE file, or the A&SP DIAGNOSTIC CONDITION file.",!
WARN ; This option should be used only with CO directive.
+1 WRITE !!?20,"********** WARNING **********"
+2 WRITE !!?5,"This option is to be used ONLY with direction from the",!?5,"Director, Audiology and Speech Pathology Service (VAHQ).",!!?20,"*****************************",!!
SURE ; Give user opportunity to exit if unsure.
+1 SET DIR(0)="Y"
SET DIR("A")="Are you sure you should continue"
SET DIR("B")="NO"
SET DIR("?")="Enter YES to continue; enter NO or press return to exit."
+2 SET DIR("??")="^D SURE^ACKQHLP1"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
GOTO EXIT
FILE ; Display files user can update and allow selection.
+1 WRITE @IOF
KILL DIR,X,Y
SET DIR(0)="NAO^1:3"
+2 SET DIR("A",1)="Select the action you wish to take."
+3 SET DIR("A",2)=""
+4 SET DIR("A",3)="1. Update the CDR ACCOUNT file (#509850)."
+5 SET DIR("A",4)="2. Update the A&SP DIAGNOSTIC CONDITION file (#509850.1)."
+6 SET DIR("A",5)="3. Update the A&SP PROCEDURE CODE file (#509850.4)."
+7 ;
+8 SET DIR("A")="Enter a number 1 thru 3: "
+9 SET DIR("?")="Select a number from 1 thru 3 or press <Return> to exit"
+10 SET DIR("??")="^D FILE^ACKQHLP1"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y="")
GOTO EXIT
+11 SET ACKANS=+Y
SET ACKFNUM=509850_$SELECT(ACKANS=3:".4",ACKANS=2:".1",1:"")
+12 SET ACKFNAM=$SELECT(ACKANS=3:"A&SP PROCEDURE CODE",ACKANS=2:"A&SP DIAGNOSTIC CONDITION",1:"CDR ACCOUNT")
ACTION ; Display actions user can take on selected file.
+1 WRITE @IOF
KILL ACKANS,DIR,X,Y
SET DIR(0)="NAO^1:2"
SET DIR("A",1)="What do you want to do with the "_ACKFNAM_" file (#"_ACKFNUM_")?"
SET DIR("A",2)=""
SET DIR("A",3)="1. Inactivate selected entries."
SET DIR("A",4)="2. Add new file entries."
SET DIR("A",5)=""
+2 SET DIR("A")="Enter a number, 1 or 2: "
SET DIR("?")="Answer 1 to make an entry inactive; answer 2 to add a new entry"
+3 SET DIR("??")="^D ACTION^ACKQHLP1"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+4 SET ACKANS=+Y
WRITE @IOF,!!
DO CNTR^ACKQUTL(ACKFNAM_" file (#"_ACKFNUM_")")
WRITE !
IF ACKANS=2
KILL ACKANS,DIR,X,Y
GOTO ^ACKQFIL1
INACT ;User wants to inactivate selected entries.
+1 SET DIC="^ACK("_ACKFNUM_","
SET DIC(0)="QEAM"
SET DIC("A")="Select entry to inactivate: "
DO ^DIC
KILL DIC
IF Y<0
DO EXIT
GOTO FILE
+2 SET ACKIEN=+Y
+3 IF ACKFNUM="509850.4"
DO LONG^ACKQUTL6(ACKIEN,"1")
+4 SET ACKPC=$SELECT(ACKFNUM="509850.4":4,ACKFNUM="509850.1":6,1:5)
SET ACKZNODE=^ACK(ACKFNUM,ACKIEN,0)
SET ACKACT=$PIECE(ACKZNODE,"^",ACKPC)
+5 IF ACKACT=1
SET $PIECE(^ACK(ACKFNUM,ACKIEN,0),"^",ACKPC)=0
WRITE !,"This entry has been inactivated.",!
DO KVAR
GOTO INACT
CHANGE ;Else entry is already marked as INACTIVE.
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A",1)="This entry is already marked as INACTIVE."
SET DIR("A")="Do you want to make it ACTIVE"
SET DIR("B")="NO"
SET DIR("?")="Answer YES to make the entry ACTIVE; enter NO to make no change."
+2 SET DIR("??")="^D CHANGE^ACKQHLP1"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
WRITE !,"No change made. This entry is still inactive.",!
DO KVAR
GOTO INACT
+3 ;User wants to change the INACTIVE entry ACTIVE.
+4 SET $PIECE(^ACK(ACKFNUM,ACKIEN,0),"^",ACKPC)=1
WRITE !,"This entry has been changed to active.",!
DO KVAR
GOTO INACT
+5 ;
EXIT ;Kill variables and exit routine.
+1 IF $DATA(ACKIEN)
LOCK -^ACK(ACKFNUM,ACKIEN)
+2 KILL %,ACKACT,ACKANS,ACKCOMP,ACKFNAM,ACKFNUM,ACKHRLOS,ACKIEN,ACKLAYGO,ACKMOD,ACKNEW,ACKORIG,ACKPC,ACKSUB,ACKZNODE,DA,DIC,DIE,DIK,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,PC,X,Y
+3 QUIT
+4 ;
KVAR ;Kill selected variables.
+1 KILL ACKACT,ACKPC,ACKZNODE,DIC,DIR,X,Y
+2 QUIT
