- 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
