ACRFBOIL ;IHS/OIRM/DSD/THL,AEF - DOCUMENT BOILER PLATE MANAGEMENT UTILITY; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE USED FOR DOCUMENT BOILER PLATE MANAGEMENT
EN ;EP;TO CREATE OR EDIT BOILER PLATE STATEMENTS
D STATE
EXIT K ACR,ACRBPDA,ACRX,ACRI,ACRY
Q
STATE ;EP;TO ADD NEW BOILER PLATE STATEMENTS
F D BOIL Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
BOIL ;SELECT AND EDIT STATEMENT
W @IOF
W !!?20,"DOCUMENT BOILER PLATE STATEMENTS"
S DIC="^ACRBP("
S DIC(0)="AEMLQZ"
S DIC("A")="BOILER PLATE STATEMENT: "
W !!
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S DA=+Y
S DIE="^ACRBP("
S DR="[ACR BOILER PLATE STATEMENT]"
D DIE^ACRFDIC
Q
DOCBOIL ;EP;UTILITY TO SELECT BOILER PLATE STATEMENTS TO ADD TO DOCUMENT
K ACRQUIT
I $D(^ACRDOCBP("C",ACRDOCDA)) D DELBOIL
W !!?3,"Select BOILER PLATES Statements"
W !
S ACR=0
S ACRBP=""
F S ACRBP=$O(^ACRBP("B",ACRBP)) Q:ACRBP="" D
.S ACRBPDA=0
.F S ACRBPDA=$O(^ACRBP("B",ACRBP,ACRBPDA)) Q:'ACRBPDA D
..I $D(^ACRBP(ACRBPDA,0)) D
...S ACR=ACR+1
...S ACR(ACR)=ACRBPDA
...W !?10,ACR
...W ?15,$P(^ACRBP(ACRBPDA,0),U)
S DIR(0)="LO^1:"_ACR
S DIR("A")="Which One(s)"
S DIR("?")="Indicate the number(s) of applicable Boiler Plate Statements."
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
N ACRI,ACRX,ACRY
S ACRY=Y
F ACRI=1:1 S ACRX=$P(ACRY,",",ACRI) Q:ACRX="" S (ACRBP,X)=ACR(ACRX) D
.I '$D(^ACRDOCBP("AC",ACRDOCDA,ACRBP)) D
..S DIC="^ACRDOCBP("
..S DIC(0)="L"
..S DIC("DR")=".02////"_ACRDOCDA
..D FILE^ACRFDIC
..S ACRBPDA=+Y
..D XY
.I $D(^ACRDOCBP("AC",ACRDOCDA,ACRBP)) S ACRBPDA=$O(^(ACRBP,0)) D
..I ACRBPDA D
...W !!,"You have added the ",$P(^ACRBP(ACRBP,0),U)," statement to this document."
...S DIR(0)="YO"
...S DIR("A")="Do you want to edit the statement"
...S DIR("B")="NO"
...D DIR^ACRFDIC
...I Y=1 D
....S DA=ACRBPDA
....S DIE="^ACRDOCBP("
....S DR=1
....D DIE^ACRFDIC
Q
XY ;SET STATEMENT FOR THE DOCUMENT EQUAL TO BOILER PLATE STATEMENT
S %X="^ACRBP("_ACR(ACRX)_",1,"
S %Y="^ACRDOCBP("_ACRBPDA_",1,"
D %XY^%RCR
K %X,%Y
Q
BAPPEND ;EP;LIST BOILER PLATE STATMENTS APPENDED TO DOCUMENT AND ALLOW FOR
;DELETION OR EDITING
Q:'$D(ACRDOCDA)
I '$D(^ACRDOCBP("C",ACRDOCDA)) W !!,"NO STATEMENTS APPENDED."
DELBOIL N ACR,ACRI S ACR=0
F ACRI=1:1 S ACR=$O(^ACRDOCBP("C",ACRDOCDA,ACR)) Q:'ACR D
.I ACRI=1 D
..W !!?10,"STATEMENTS APPENDED:"
..W !?10,"------------------------"
.I $D(^ACRDOCBP(ACR,0)) S ACRBP=+^(0) D:ACRBP
..W !?10,ACRI
..W ?15,$P(^ACRBP(ACRBP,0),U)
..D D1
Q
D1 ;
S DIR(0)="YO"
S DIR("A")=" Read Statement NO. "_ACRI_" "
S DIR("B")="NO"
D DIR^ACRFDIC
I Y=1 D
.S D0=ACR
.N DXS,DIP,DC,DN
.W @IOF
.W !
.D ^ACRBP
.D PAUSE^ACRFWARN
.W !
Q:$D(ACRREV)
S DIR(0)="SO^1:Edit Statement No. "_ACRI_";2:Delete Statement No. "_ACRI
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!("12"'[Y)
I Y=1 D Q
.S DA=ACR
.S DIE="^ACRDOCBP("
.S DR="[ACR BP STATEMENT]"
.W @IOF
.D DIE^ACRFDIC
I Y=2 D
.S DIR(0)="YO"
.S DIR("A")="Sure you want to delete Statement No. "_ACRI
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.Q:Y'=1
.S DA=ACR
.S DIK="^ACRDOCBP("
.K ^ACRDOCBP("C",ACRDOCDA,DA),^ACRDOCBP("AC",ACRDOCDA,ACRBP,DA)
.W !!,"Statement NO. "_ACRI_" deleted."
Q
PBOIL ;EP;TO PRINT BOILER PLATE STATEMENT ATTACHED TO A DOCUMENT
Q:$D(ACROUT)
W:$O(^ACRDOCBP("C",ACRDOCDA,0)) @IOF
N ACR,D0
S ACR=0
F S ACR=$O(^ACRDOCBP("C",ACRDOCDA,ACR)) Q:'ACR D
.N DXS,DIP,DC,DN
.S D0=ACR
.I $E($G(IOST),1,2)="C-" D Q:'$D(ACRSCREN)
..N ACRFILE,ACRIEN,ACRFIELD,ACRTITLE
..S ACRFILE=9002197.3
..S ACRIEN=ACR
..S ACRFIELD=1
..S ACRTITLE="ARMS BOILER PLATE STATEMENT"
..D WP^ACRFDIC
.K ACRSCREN
.D ^ACRBP
.S ACRX=+^ACRDOCBP(ACR,0)
.I $P(^ACRBP(ACRX,0),U,2),$D(^ACRAPVS("AB",ACRDOCDA)) D
..N ACRAPVT
..S ACRAPVT=5
..D SIG^ACRFCERT
.I $E($G(IOST),1,2)["C-" D PAUSE^ACRFWARN
.W @IOF
Q
ACRFBOIL ;IHS/OIRM/DSD/THL,AEF - DOCUMENT BOILER PLATE MANAGEMENT UTILITY; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE USED FOR DOCUMENT BOILER PLATE MANAGEMENT
EN ;EP;TO CREATE OR EDIT BOILER PLATE STATEMENTS
+1 DO STATE
EXIT KILL ACR,ACRBPDA,ACRX,ACRI,ACRY
+1 QUIT
STATE ;EP;TO ADD NEW BOILER PLATE STATEMENTS
+1 FOR
DO BOIL
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
BOIL ;SELECT AND EDIT STATEMENT
+1 WRITE @IOF
+2 WRITE !!?20,"DOCUMENT BOILER PLATE STATEMENTS"
+3 SET DIC="^ACRBP("
+4 SET DIC(0)="AEMLQZ"
+5 SET DIC("A")="BOILER PLATE STATEMENT: "
+6 WRITE !!
+7 DO DIC^ACRFDIC
+8 IF +Y<1
SET ACRQUIT=""
QUIT
+9 SET DA=+Y
+10 SET DIE="^ACRBP("
+11 SET DR="[ACR BOILER PLATE STATEMENT]"
+12 DO DIE^ACRFDIC
+13 QUIT
DOCBOIL ;EP;UTILITY TO SELECT BOILER PLATE STATEMENTS TO ADD TO DOCUMENT
+1 KILL ACRQUIT
+2 IF $DATA(^ACRDOCBP("C",ACRDOCDA))
DO DELBOIL
+3 WRITE !!?3,"Select BOILER PLATES Statements"
+4 WRITE !
+5 SET ACR=0
+6 SET ACRBP=""
+7 FOR
SET ACRBP=$ORDER(^ACRBP("B",ACRBP))
IF ACRBP=""
QUIT
Begin DoDot:1
+8 SET ACRBPDA=0
+9 FOR
SET ACRBPDA=$ORDER(^ACRBP("B",ACRBP,ACRBPDA))
IF 'ACRBPDA
QUIT
Begin DoDot:2
+10 IF $DATA(^ACRBP(ACRBPDA,0))
Begin DoDot:3
+11 SET ACR=ACR+1
+12 SET ACR(ACR)=ACRBPDA
+13 WRITE !?10,ACR
+14 WRITE ?15,$PIECE(^ACRBP(ACRBPDA,0),U)
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET DIR(0)="LO^1:"_ACR
+16 SET DIR("A")="Which One(s)"
+17 SET DIR("?")="Indicate the number(s) of applicable Boiler Plate Statements."
+18 WRITE !
+19 DO DIR^ACRFDIC
+20 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+21 NEW ACRI,ACRX,ACRY
+22 SET ACRY=Y
+23 FOR ACRI=1:1
SET ACRX=$PIECE(ACRY,",",ACRI)
IF ACRX=""
QUIT
SET (ACRBP,X)=ACR(ACRX)
Begin DoDot:1
+24 IF '$DATA(^ACRDOCBP("AC",ACRDOCDA,ACRBP))
Begin DoDot:2
+25 SET DIC="^ACRDOCBP("
+26 SET DIC(0)="L"
+27 SET DIC("DR")=".02////"_ACRDOCDA
+28 DO FILE^ACRFDIC
+29 SET ACRBPDA=+Y
+30 DO XY
End DoDot:2
+31 IF $DATA(^ACRDOCBP("AC",ACRDOCDA,ACRBP))
SET ACRBPDA=$ORDER(^(ACRBP,0))
Begin DoDot:2
+32 IF ACRBPDA
Begin DoDot:3
+33 WRITE !!,"You have added the ",$PIECE(^ACRBP(ACRBP,0),U)," statement to this document."
+34 SET DIR(0)="YO"
+35 SET DIR("A")="Do you want to edit the statement"
+36 SET DIR("B")="NO"
+37 DO DIR^ACRFDIC
+38 IF Y=1
Begin DoDot:4
+39 SET DA=ACRBPDA
+40 SET DIE="^ACRDOCBP("
+41 SET DR=1
+42 DO DIE^ACRFDIC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
XY ;SET STATEMENT FOR THE DOCUMENT EQUAL TO BOILER PLATE STATEMENT
+1 SET %X="^ACRBP("_ACR(ACRX)_",1,"
+2 SET %Y="^ACRDOCBP("_ACRBPDA_",1,"
+3 DO %XY^%RCR
+4 KILL %X,%Y
+5 QUIT
BAPPEND ;EP;LIST BOILER PLATE STATMENTS APPENDED TO DOCUMENT AND ALLOW FOR
+1 ;DELETION OR EDITING
+2 IF '$DATA(ACRDOCDA)
QUIT
+3 IF '$DATA(^ACRDOCBP("C",ACRDOCDA))
WRITE !!,"NO STATEMENTS APPENDED."
DELBOIL NEW ACR,ACRI
SET ACR=0
+1 FOR ACRI=1:1
SET ACR=$ORDER(^ACRDOCBP("C",ACRDOCDA,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+2 IF ACRI=1
Begin DoDot:2
+3 WRITE !!?10,"STATEMENTS APPENDED:"
+4 WRITE !?10,"------------------------"
End DoDot:2
+5 IF $DATA(^ACRDOCBP(ACR,0))
SET ACRBP=+^(0)
IF ACRBP
Begin DoDot:2
+6 WRITE !?10,ACRI
+7 WRITE ?15,$PIECE(^ACRBP(ACRBP,0),U)
+8 DO D1
End DoDot:2
End DoDot:1
+9 QUIT
D1 ;
+1 SET DIR(0)="YO"
+2 SET DIR("A")=" Read Statement NO. "_ACRI_" "
+3 SET DIR("B")="NO"
+4 DO DIR^ACRFDIC
+5 IF Y=1
Begin DoDot:1
+6 SET D0=ACR
+7 NEW DXS,DIP,DC,DN
+8 WRITE @IOF
+9 WRITE !
+10 DO ^ACRBP
+11 DO PAUSE^ACRFWARN
+12 WRITE !
End DoDot:1
+13 IF $DATA(ACRREV)
QUIT
+14 SET DIR(0)="SO^1:Edit Statement No. "_ACRI_";2:Delete Statement No. "_ACRI
+15 WRITE !
+16 DO DIR^ACRFDIC
+17 IF $DATA(ACRQUIT)!$DATA(ACROUT)!("12"'[Y)
QUIT
+18 IF Y=1
Begin DoDot:1
+19 SET DA=ACR
+20 SET DIE="^ACRDOCBP("
+21 SET DR="[ACR BP STATEMENT]"
+22 WRITE @IOF
+23 DO DIE^ACRFDIC
End DoDot:1
QUIT
+24 IF Y=2
Begin DoDot:1
+25 SET DIR(0)="YO"
+26 SET DIR("A")="Sure you want to delete Statement No. "_ACRI
+27 SET DIR("B")="NO"
+28 WRITE !
+29 DO DIR^ACRFDIC
+30 IF Y'=1
QUIT
+31 SET DA=ACR
+32 SET DIK="^ACRDOCBP("
+33 KILL ^ACRDOCBP("C",ACRDOCDA,DA),^ACRDOCBP("AC",ACRDOCDA,ACRBP,DA)
+34 WRITE !!,"Statement NO. "_ACRI_" deleted."
End DoDot:1
+35 QUIT
PBOIL ;EP;TO PRINT BOILER PLATE STATEMENT ATTACHED TO A DOCUMENT
+1 IF $DATA(ACROUT)
QUIT
+2 IF $ORDER(^ACRDOCBP("C",ACRDOCDA,0))
WRITE @IOF
+3 NEW ACR,D0
+4 SET ACR=0
+5 FOR
SET ACR=$ORDER(^ACRDOCBP("C",ACRDOCDA,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+6 NEW DXS,DIP,DC,DN
+7 SET D0=ACR
+8 IF $EXTRACT($GET(IOST),1,2)="C-"
Begin DoDot:2
+9 NEW ACRFILE,ACRIEN,ACRFIELD,ACRTITLE
+10 SET ACRFILE=9002197.3
+11 SET ACRIEN=ACR
+12 SET ACRFIELD=1
+13 SET ACRTITLE="ARMS BOILER PLATE STATEMENT"
+14 DO WP^ACRFDIC
End DoDot:2
IF '$DATA(ACRSCREN)
QUIT
+15 KILL ACRSCREN
+16 DO ^ACRBP
+17 SET ACRX=+^ACRDOCBP(ACR,0)
+18 IF $PIECE(^ACRBP(ACRX,0),U,2)
IF $DATA(^ACRAPVS("AB",ACRDOCDA))
Begin DoDot:2
+19 NEW ACRAPVT
+20 SET ACRAPVT=5
+21 DO SIG^ACRFCERT
End DoDot:2
+22 IF $EXTRACT($GET(IOST),1,2)["C-"
DO PAUSE^ACRFWARN
+23 WRITE @IOF
End DoDot:1
+24 QUIT
