ACRFDCC ;IHS/OIRM/DSD/THL,AEF - CHANGE DEFAULT CAN DATA FOR ALL CAN'S; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE USED TO CHANGE DEFAULT CAN DATA FOR ALL CAN'S DURING CAN
;;DEFAULT EDIT
EN2 ;EP;CHANGE DATA
N ACRDA,ACRALL,ACR,ACRCAN,ACRCANDA,ACRLBDA,ACRDPT,ACRDPTX,ACRI,ACRJ,ACRSEL,ACRN,ACRP,ACRFR,ACRTO,ACRQUIT,ACRY
D EN21
EXIT K ^TMP("ACRDCC",$J),^TMP("ACRDCAN",$J)
Q
EN21 W !!,"You selected to make changes in CAN DEFAULT data."
S DIR(0)="YO"
S DIR("A")="Proceed to make changes"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
Q:Y'=1
D WHICH
Q:'$O(^TMP("ACRDCAN",$J,0))
W !
D:$E($G(IOST),1,2)="C-" WAIT^DICD
S ACRDA=0
F S ACRDA=$O(^TMP("ACRDCAN",$J,ACRDA)) Q:'ACRDA D
.S ACRF=0,DR=""
.F S ACRF=$O(^TMP("ACRDCC",$J,ACRF)) Q:'ACRF D
..S ACRP=^TMP("ACRDCC",$J,ACRF)
..S ACRFR=$P(ACRP,U)
..S ACRTO=$P(ACRP,U,2)
..S ACRN=$P(ACRP,U,4)
..S ACRP=$P(ACRP,U,3)
..I $D(^ACRCAN(ACRDA,ACRN)),$P(^(ACRN),U,ACRP)'=ACRTO S DR=DR_ACRF_"////"_ACRTO_";"
.Q:DR=""
.W !,$P(^AUTTCAN(ACRDA,0),U)," has been changed."
.S DA=ACRDA
.S DIE="^ACRCAN("
.D DIE^ACRFDIC
D PAUSE^ACRFWARN
Q
INQ ;EP;TO INQUIRE IF CHANGE SHOULD APPLY TO ALL CAN'S
Q:'$G(ACRF)
N %
W !!,"Should this change apply to other CAN's"
S %=2
D YN^DICN
Q:%'=1
S %=$P($G(^DD(9002186.5,ACRF,0)),U,4)
S ^TMP("ACRDCC",$J,ACRF)=ACRFR_U_ACRTO_U_$P(%,";",2)_U_$P(%,";")
K ACRF,ACRFR,ACRTO,ACRP,ACR,ACRQUIT,ACRN
W !,"Change will take place after edit completed."
W !
Q
WHICH ;EP;TO CHANGE ALL OR SELECTED CANS
F D W Q:$D(ACRQUIT)
K ACRQUIT
Q
W S DIR(0)="SO^1:Change all CAN's;2:Change selected CAN's"
S DIR("?",1)="Select '1' to have the change made to ALL CAN's."
S DIR("?",2)="Select '2' to choose selected CAN's to change."
S DIR("?")="Choose an option from the list"
W !
D DIR^ACRFDIC
I "12"'[+$G(Y) S ACRQUIT="" Q
S ACRALL=Y
I Y=1 D ALL Q
I Y=2 D SELECT Q
Q
SELECT ;SELECT CAN'S FOR CHANGE
F D S Q:$D(ACRQUIT)
K ACRQUIT
Q
S S DIR(0)="SO^1:List ALL CAN's;2:List ONLY ACTIVE CAN's;3:Select CAN's One by One"
S DIR("?",1)="Select '1' to get a list of ALL CAN's used by ARMS as DEFAULT CAN's."
S DIR("?",2)="Select '2' to get a list of CAN's for current Department Accounts."
S DIR("?",3)="Select '3' to select CAN's individually"
S DIR("?")="Choose an option from the list"
W !
W:$O(^TMP("ACRDCAN",$J,0)) "You may now select additional CAN's if you wish."
D DIR^ACRFDIC
I "123"'[+$G(Y) S ACRQUIT="" Q
I Y=3 D ONE Q
S ACRSEL=+Y
D LIST
Q
LIST ;LIST CANS
D L
D CHOOSE
Q
L W @IOF
W !?10,"NO."
W ?18,"CAN"
W ?27,"DEPARTMENT"
W !?10,"------"
W ?18,"-------"
W ?27,"------------------------------"
S ACR=""
S ACRJ=0
F S ACR=$O(^AUTTCAN("B",ACR)) Q:ACR=""!$D(ACRQUIT) D
.S ACRCANDA=0
.F S ACRCANDA=$O(^AUTTCAN("B",ACR,ACRCANDA)) Q:'ACRCANDA!$D(ACRQUIT) I $D(^ACRLOCB("DCAN",ACRCANDA)) D
..S (ACRI,ACRLBDA)=0
..F S ACRLBDA=$O(^ACRLOCB("DCAN",ACRCANDA,ACRLBDA)) Q:'ACRLBDA!$D(ACRQUIT) D
...I ACRLBDA,$D(^ACRLOCB(ACRLBDA,0)) S ACRDPTDA=$P(^(0),U,5) I ACRDPTDA,$D(^AUTTPRG(ACRDPTDA,0)) S ACRDPT=$P(^(0),U) D:ACRDPT]""
...Q:ACRSEL=2&'$D(^ACRLOCB(ACRLBDA,"SC",0))
...S ACRI=ACRI+1
...I ACRI=1 D
....S ACRJ=ACRJ+1
....S ACRCAN(ACRJ)=ACRCANDA
...I ACRI=1 D
....W !?10,ACRJ
....W ?18,ACR
....W ?27,ACRDPT
...I ACRI>1,ACRDPTX'=ACRDPT W !?27,ACRDPT
...S ACRDPTX=ACRDPT
...I $Y>(IOSL-4) D PAUSE^ACRFWARN W:'$D(ACRQUIT) @IOF
K ACRQUIT
Q
ONE ;SELECT INDIVIDUAL CAN'S
F D O Q:$D(ACRQUIT)
K ACRQUIT
Q
O S DIC="^AUTTCAN("
S DIC(0)="AEMQZ"
S DIC("A")="Select a CAN: "
S DIC("S")="I $D(^ACRLOCB(""DCAN"",+Y))"
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
I +Y>0 S ^TMP("ACRDCAN",$J,+Y)=""
I $O(^TMP("ACRDCAN",$J,0)) S DIC("A")="Select another CAN: "
Q
CHOOSE ;CHOOSE CAN'S FROM LIST
S DIR(0)="LO^1:"_ACRJ,DIR("A")="Which CAN(s)"
W !
D DIR^ACRFDIC
F ACRI=1:1 S ACRX=$P(Y,",",ACRI) Q:ACRX="" S:$D(ACRCAN(ACRX))#2 ^TMP("ACRDCAN",$J,ACRCAN(ACRX))=""
Q
ALL ;SET TEMPORARY ARRAY WITH ALL DEFAULT CAN'S
S ACR=0
F S ACR=$O(^ACRCAN(ACR)) Q:'ACR I $D(^ACRCAN(ACR,"DFLT")) S ^TMP("ACRDCAN",$J,ACR)=""
Q
ACRFDCC ;IHS/OIRM/DSD/THL,AEF - CHANGE DEFAULT CAN DATA FOR ALL CAN'S; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE USED TO CHANGE DEFAULT CAN DATA FOR ALL CAN'S DURING CAN
+3 ;;DEFAULT EDIT
EN2 ;EP;CHANGE DATA
+1 NEW ACRDA,ACRALL,ACR,ACRCAN,ACRCANDA,ACRLBDA,ACRDPT,ACRDPTX,ACRI,ACRJ,ACRSEL,ACRN,ACRP,ACRFR,ACRTO,ACRQUIT,ACRY
+2 DO EN21
EXIT KILL ^TMP("ACRDCC",$JOB),^TMP("ACRDCAN",$JOB)
+1 QUIT
EN21 WRITE !!,"You selected to make changes in CAN DEFAULT data."
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Proceed to make changes"
+3 SET DIR("B")="YES"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'=1
QUIT
+7 DO WHICH
+8 IF '$ORDER(^TMP("ACRDCAN",$JOB,0))
QUIT
+9 WRITE !
+10 IF $EXTRACT($GET(IOST),1,2)="C-"
DO WAIT^DICD
+11 SET ACRDA=0
+12 FOR
SET ACRDA=$ORDER(^TMP("ACRDCAN",$JOB,ACRDA))
IF 'ACRDA
QUIT
Begin DoDot:1
+13 SET ACRF=0
SET DR=""
+14 FOR
SET ACRF=$ORDER(^TMP("ACRDCC",$JOB,ACRF))
IF 'ACRF
QUIT
Begin DoDot:2
+15 SET ACRP=^TMP("ACRDCC",$JOB,ACRF)
+16 SET ACRFR=$PIECE(ACRP,U)
+17 SET ACRTO=$PIECE(ACRP,U,2)
+18 SET ACRN=$PIECE(ACRP,U,4)
+19 SET ACRP=$PIECE(ACRP,U,3)
+20 IF $DATA(^ACRCAN(ACRDA,ACRN))
IF $PIECE(^(ACRN),U,ACRP)'=ACRTO
SET DR=DR_ACRF_"////"_ACRTO_";"
End DoDot:2
+21 IF DR=""
QUIT
+22 WRITE !,$PIECE(^AUTTCAN(ACRDA,0),U)," has been changed."
+23 SET DA=ACRDA
+24 SET DIE="^ACRCAN("
+25 DO DIE^ACRFDIC
End DoDot:1
+26 DO PAUSE^ACRFWARN
+27 QUIT
INQ ;EP;TO INQUIRE IF CHANGE SHOULD APPLY TO ALL CAN'S
+1 IF '$GET(ACRF)
QUIT
+2 NEW %
+3 WRITE !!,"Should this change apply to other CAN's"
+4 SET %=2
+5 DO YN^DICN
+6 IF %'=1
QUIT
+7 SET %=$PIECE($GET(^DD(9002186.5,ACRF,0)),U,4)
+8 SET ^TMP("ACRDCC",$JOB,ACRF)=ACRFR_U_ACRTO_U_$PIECE(%,";",2)_U_$PIECE(%,";")
+9 KILL ACRF,ACRFR,ACRTO,ACRP,ACR,ACRQUIT,ACRN
+10 WRITE !,"Change will take place after edit completed."
+11 WRITE !
+12 QUIT
WHICH ;EP;TO CHANGE ALL OR SELECTED CANS
+1 FOR
DO W
IF $DATA(ACRQUIT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
W SET DIR(0)="SO^1:Change all CAN's;2:Change selected CAN's"
+1 SET DIR("?",1)="Select '1' to have the change made to ALL CAN's."
+2 SET DIR("?",2)="Select '2' to choose selected CAN's to change."
+3 SET DIR("?")="Choose an option from the list"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF "12"'[+$GET(Y)
SET ACRQUIT=""
QUIT
+7 SET ACRALL=Y
+8 IF Y=1
DO ALL
QUIT
+9 IF Y=2
DO SELECT
QUIT
+10 QUIT
SELECT ;SELECT CAN'S FOR CHANGE
+1 FOR
DO S
IF $DATA(ACRQUIT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
S SET DIR(0)="SO^1:List ALL CAN's;2:List ONLY ACTIVE CAN's;3:Select CAN's One by One"
+1 SET DIR("?",1)="Select '1' to get a list of ALL CAN's used by ARMS as DEFAULT CAN's."
+2 SET DIR("?",2)="Select '2' to get a list of CAN's for current Department Accounts."
+3 SET DIR("?",3)="Select '3' to select CAN's individually"
+4 SET DIR("?")="Choose an option from the list"
+5 WRITE !
+6 IF $ORDER(^TMP("ACRDCAN",$JOB,0))
WRITE "You may now select additional CAN's if you wish."
+7 DO DIR^ACRFDIC
+8 IF "123"'[+$GET(Y)
SET ACRQUIT=""
QUIT
+9 IF Y=3
DO ONE
QUIT
+10 SET ACRSEL=+Y
+11 DO LIST
+12 QUIT
LIST ;LIST CANS
+1 DO L
+2 DO CHOOSE
+3 QUIT
L WRITE @IOF
+1 WRITE !?10,"NO."
+2 WRITE ?18,"CAN"
+3 WRITE ?27,"DEPARTMENT"
+4 WRITE !?10,"------"
+5 WRITE ?18,"-------"
+6 WRITE ?27,"------------------------------"
+7 SET ACR=""
+8 SET ACRJ=0
+9 FOR
SET ACR=$ORDER(^AUTTCAN("B",ACR))
IF ACR=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+10 SET ACRCANDA=0
+11 FOR
SET ACRCANDA=$ORDER(^AUTTCAN("B",ACR,ACRCANDA))
IF 'ACRCANDA!$DATA(ACRQUIT)
QUIT
IF $DATA(^ACRLOCB("DCAN",ACRCANDA))
Begin DoDot:2
+12 SET (ACRI,ACRLBDA)=0
+13 FOR
SET ACRLBDA=$ORDER(^ACRLOCB("DCAN",ACRCANDA,ACRLBDA))
IF 'ACRLBDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:3
+14 IF ACRLBDA
IF $DATA(^ACRLOCB(ACRLBDA,0))
SET ACRDPTDA=$PIECE(^(0),U,5)
IF ACRDPTDA
IF $DATA(^AUTTPRG(ACRDPTDA,0))
SET ACRDPT=$PIECE(^(0),U)
IF ACRDPT]""
Begin DoDot:4
End DoDot:4
+15 IF ACRSEL=2&'$DATA(^ACRLOCB(ACRLBDA,"SC",0))
QUIT
+16 SET ACRI=ACRI+1
+17 IF ACRI=1
Begin DoDot:4
+18 SET ACRJ=ACRJ+1
+19 SET ACRCAN(ACRJ)=ACRCANDA
End DoDot:4
+20 IF ACRI=1
Begin DoDot:4
+21 WRITE !?10,ACRJ
+22 WRITE ?18,ACR
+23 WRITE ?27,ACRDPT
End DoDot:4
+24 IF ACRI>1
IF ACRDPTX'=ACRDPT
WRITE !?27,ACRDPT
+25 SET ACRDPTX=ACRDPT
+26 IF $Y>(IOSL-4)
DO PAUSE^ACRFWARN
IF '$DATA(ACRQUIT)
WRITE @IOF
End DoDot:3
End DoDot:2
End DoDot:1
+27 KILL ACRQUIT
+28 QUIT
ONE ;SELECT INDIVIDUAL CAN'S
+1 FOR
DO O
IF $DATA(ACRQUIT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
O SET DIC="^AUTTCAN("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Select a CAN: "
+3 SET DIC("S")="I $D(^ACRLOCB(""DCAN"",+Y))"
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 IF +Y>0
SET ^TMP("ACRDCAN",$JOB,+Y)=""
+8 IF $ORDER(^TMP("ACRDCAN",$JOB,0))
SET DIC("A")="Select another CAN: "
+9 QUIT
CHOOSE ;CHOOSE CAN'S FROM LIST
+1 SET DIR(0)="LO^1:"_ACRJ
SET DIR("A")="Which CAN(s)"
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 FOR ACRI=1:1
SET ACRX=$PIECE(Y,",",ACRI)
IF ACRX=""
QUIT
IF $DATA(ACRCAN(ACRX))#2
SET ^TMP("ACRDCAN",$JOB,ACRCAN(ACRX))=""
+5 QUIT
ALL ;SET TEMPORARY ARRAY WITH ALL DEFAULT CAN'S
+1 SET ACR=0
+2 FOR
SET ACR=$ORDER(^ACRCAN(ACR))
IF 'ACR
QUIT
IF $DATA(^ACRCAN(ACR,"DFLT"))
SET ^TMP("ACRDCAN",$JOB,ACR)=""
+3 QUIT
