PRCFFERT ;WISC/SJG-OBLIGATION ERROR PROCESSING REBUILD/RETRANSMIT ;7/24/00 23:20
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
TYPE(X) N FMSNO,STATUS
S PRC("SITE")=$P(X,U)
I ("^AR^MO^SO^"'[("^"_$P(X,U,2)_"^")) D MSG1^PRCFFERM,OUT Q
S STATUS=$G(GECSDATA(2100.1,GECSDATA,3,"E"))
D MSG^PRCFFER2($E(STATUS,1),.PRCFA) ; display transaction status info
D NUM^PRCFFERU ; put external PO# from GECSDATA into PONUM
D GET^PRCFFERU(442,PONUM) ; DIC call
I Y<0 D MSG2^PRCFFERM Q
S PO=Y,PO(0)=Y(0),PO(0,0)=Y(0,0)
S POIEN=+Y
K MOP S MOP=$P(Y(0),U,2) I MOP="" D MSG3^PRCFFERM Q
D GECS ; save selected txn's type & action in PRCFA("GECS")
I ("^1^2^3^4^7^8^26^"[("^"_MOP_"^")) I PRCFA("ERROR") D TPO
I MOP=21 I PRCFA("ERROR") D T1358
D OUT
D SCREEN
QUIT
;
TPO ; Purchase Order Error Processing when MOP = Invoice/Rec Rep,CI,Req
I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="POREQ" W !! D MSG5^PRCFFERM H 3 Q
S D0=+Y D STATR1^PRCFFERU(2)
S X=$P($G(RESP),U) I X D ^PRCHDP1
W ! S RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
S X=$P($G(RETRAN),U) I 'X D MSG4^PRCFFERM H 3 Q
TPO1 D
.S PRCFA("RETRAN")=1
.S PRCFA("PODA")=+PO,PCP=$P(PO(0),U,3)
.S $P(PCP,U,2)=$S($D(^PRC(420,PRC("SITE"),1,+PCP,0)):$P(^(0),U,12),1:"")
.I '$D(PRC("FY")) D
..N FYQ S FYQ=$$FYQ^PRCFFERU(.FYQ)
..S PRC("FY")=$P(FYQ,U),PRC("QTR")=$P(FYQ,U,2)
..Q
.I '$D(PRC("PARAM")) S PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
.N PRCRGS,MODDOC S FLG=0
.S MODDOC=$P($G(PRCFA("GECS")),"^",3)
.S PRCRGS=$S(MODDOC="":1,MODDOC]"":2)
.I MODDOC="" D RETRAN^PRCFFMO Q
.I MODDOC]"" D Q
..N RBLD S RBLD=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
..I RBLD]"" S (PRCFA("AMEND#"),PRCFAA)=$P(RBLD,"/",2),PRCFPODA=+PO
..I RBLD="" D
...S (PRCFA("AMEND#"),X)=0
...F S X=$O(^PRC(442,+PO,6,X)) Q:X'>0 S PRCFAA=X
...S PRCFA("AMEND#")=PRCFAA,PRCFPODA=+PO
...Q
..D SETAM,RETRAN^PRCFFMOM
..Q
.Q
Q
SETPO ;
S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
S DESC="Purchase Order Obligation Rebuild/Transmit"
S:MODDOC]"" DESC="Purchase Order Amendment Rebuild/Transmit"
D REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
S GECSFMS("DA")=GECSDATA
Q
SETAM ;
N DIC S DIC="^PRC(442,"_+PO_",6,",DIC(0)="MNZ",X=PRCFA("AMEND#")
D ^DIC I +Y>0 S PO(6)=Y(0),PO(6,1)=^PRC(442,+PO,6,PRCFA("AMEND#"),1)
Q
T1358 ; 1358 Error Processing when MOP = MISC OBL(1358)
I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="MISCOBL" W !! D MSG5^PRCFFERM H 3 Q
D STATR1^PRCFFERU(2)
D GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
S (OB,DA)=$G(PRCTMP(442,+POIEN,".07","I"))
D NODE^PRCS58OB(DA,.TRNODE)
I '$D(PRC("CP")) S PRC("CP")=$P(TRNODE(0),"-",4)
S X=$P($G(RESP),U) I X D
.D PAUSE1^PRCFFERU
.S IOP="HOME" D ^%ZIS,^PRCE58P0
.Q
W ! S RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
S X=$P($G(RETRAN),U) I 'X D MSG4^PRCFFERM H 3 Q
T13581 D
.S PRCFA("RETRAN")=1,DA=OB
.I '$D(PRC("FY")) D
..N FYQ S FYQ=$$FYQ^PRCFFERU(.FYQ)
..S PRC("FY")=$P(FYQ,U),PRC("QTR")=$P(FYQ,U,3)
..Q
.I '$D(PRC("PARAM")) S PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
.N PRCRGS,MODDOC
.S MODDOC=$P($G(PRCFA("GECS")),"^",3)
.S PRCRGS=$S(MODDOC="":1,MODDOC]"":2)
.I MODDOC="" D SC^PRCESOE Q
.I MODDOC]"" D Q
..N RBLD S RBLD=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
..I RBLD]"" S Y=$P(RBLD,"/",4)
..I RBLD="" D
...S PATNUM=$$STRIP^PRCFFERU(PATNUM)
...S Y=$O(^PRCS(410,"D",PATNUM,0))
...Q
..W ! D RETRAN^PRCEADJ1 Q
Q
;
SET1358 S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
S DESC="1358 Obligation Rebuild/Transmit"
S:MODDOC]"" DESC="1358 Obligation Adjustment Rebuild/Transmit"
D REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
S GECSFMS("DA")=GECSDATA
Q
;
; get current txn's type, action & amendment/adjustment #
GECS N LOOP,NODE,X
S LOOP=0,PRCFA("GECS")=""
F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0!($G(PRCFA("GECS"))'="") D
. S NODE=^PRC(442,+PO,10,LOOP,0)
. I GECSDATA(2100.1,GECSDATA,.01,"E")=$P(NODE,"^",4) D
. . S PRCFA("GECS")=$E(NODE,1,2)_"^"_$E(NODE,4)_"^"_$P(NODE,"^",10)_"^"_$P(NODE,"^",9)
. . I MOP=21 S $P(PRCFA("GECS"),"^",3)=$P(NODE,"^",11) ; 1358s
Q
;
; find all FMS txn associated with the amendment/adjustment #
; PO = purchase order ien
; VER = amendment/adjustment #
; MOP = method of processing
; returns DOC IDs for SO, AR.E, AR.M codesheets on same amend/adjust#
GETTXNS(PO,VER,MOP) N LOOP,NODE,PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN,TYPE,X
S TYPE=10 I MOP=21 S TYPE=11 ; piece holding amend/adjust#
S LOOP=0,(PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN)=""
F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0 D
. S NODE=^PRC(442,+PO,10,LOOP,0)
. I $E(NODE,1,4)="SO.E",VER=$P(NODE,"^",TYPE) S PRCSOE=$P(NODE,"^",4)
. I $E(NODE,1,4)="SO.M",VER=$P(NODE,"^",TYPE) S PRCSOM=$P(NODE,"^",4)
. I $E(NODE,1,4)="AR.E",VER=$P(NODE,"^",TYPE) S PRCARE=$P(NODE,"^",4)
. I $E(NODE,1,4)="AR.M",VER=$P(NODE,"^",TYPE) S PRCARM=$P(NODE,"^",4)
. I $E(NODE,4)="X",VER=$P(NODE,"^",TYPE) S PRCCAN=1 ; canceled amend#
S X=PRCSOE_"^"_PRCSOM_"^"_PRCARE_"^"_PRCARM_"^"_PRCCAN
Q X
;
;
; Compares transaction types passed to string of existing transactions
; returns .01 field of file 2100.1 if transaction type is in string
; zero, if types are not in string
;
; TXNTP = Transaction Type
; TXNAC = Transaction Action
; STRING (Of 2100.1 doc id's) = SOE ^ SOM ^ ARE ^ ARM ^ flag for cancel
;
NEWCHK(TXNTP,TXNAC,STRING) N DOCID
S DOCID=0
I $P(TXNTP,"^",5)'=1 D ; amend# canceled
. I $P(TXNTP,":")="SO",TXNAC="E",$P(STRING,"^",1)]"" S DOCID=$P(STRING,"^",1)
. I $P(TXNTP,":")="SO",TXNAC="M",$P(STRING,"^",2)]"" S DOCID=$P(STRING,"^",2)
. I $P(TXNTP,":")="AR",TXNAC="E",$P(STRING,"^",3)]"" S DOCID=$P(STRING,"^",3)
. I $P(TXNTP,":")="AR",TXNAC="M",$P(STRING,"^",4)]"" S DOCID=$P(STRING,"^",4)
Q DOCID
;
; Check the selected transaction
; if unavailable, give message & return '^'
; if available, set up GECSDATA array and return 1
SWITCH(DOCID,MP,GECSDATA) ;
N STATUS,X
D EN^DDIOL("Document exists for "_DOCID_". Attempting to rebuild.")
D EN^DDIOL(" ")
S STATUS=$$STATUS^GECSSGET(DOCID)
I "RENT"'[$E(STATUS) D
. D EN^DDIOL("Unable to rebuild now -- document has status of "_STATUS_".")
. S X=$S($E(DOCID,1,2)="AR":"AR",MP=21:"SO",1:"MO/SO")
. D EN^DDIOL("Please rebuild "_DOCID_" later using the "_X_" option.")
. S X="^"
I "RENT"[$E(STATUS) D
. D DATA^GECSSGET(DOCID,0)
. D EN^DDIOL("Rebuild will continue using "_DOCID_".")
. S X=1
Q X
;
OUT K GECSDATA,FMSNO,STATUS,DIC,FMSSEC,DESC
Q
SCREEN ; Control screen display
I $D(IOF) W @IOF
HDR ; Write Option Header
I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFERT 6679 printed Sep 02, 2024@18:48:41 Page 2
PRCFFERT ;WISC/SJG-OBLIGATION ERROR PROCESSING REBUILD/RETRANSMIT ;7/24/00 23:20
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
TYPE(X) NEW FMSNO,STATUS
+1 SET PRC("SITE")=$PIECE(X,U)
+2 IF ("^AR^MO^SO^"'[("^"_$PIECE(X,U,2)_"^"))
DO MSG1^PRCFFERM
DO OUT
QUIT
+3 SET STATUS=$GET(GECSDATA(2100.1,GECSDATA,3,"E"))
+4 ; display transaction status info
DO MSG^PRCFFER2($EXTRACT(STATUS,1),.PRCFA)
+5 ; put external PO# from GECSDATA into PONUM
DO NUM^PRCFFERU
+6 ; DIC call
DO GET^PRCFFERU(442,PONUM)
+7 IF Y<0
DO MSG2^PRCFFERM
QUIT
+8 SET PO=Y
SET PO(0)=Y(0)
SET PO(0,0)=Y(0,0)
+9 SET POIEN=+Y
+10 KILL MOP
SET MOP=$PIECE(Y(0),U,2)
IF MOP=""
DO MSG3^PRCFFERM
QUIT
+11 ; save selected txn's type & action in PRCFA("GECS")
DO GECS
+12 IF ("^1^2^3^4^7^8^26^"[("^"_MOP_"^"))
IF PRCFA("ERROR")
DO TPO
+13 IF MOP=21
IF PRCFA("ERROR")
DO T1358
+14 DO OUT
+15 DO SCREEN
+16 QUIT
+17 ;
TPO ; Purchase Order Error Processing when MOP = Invoice/Rec Rep,CI,Req
+1 IF $DATA(PRCFA("ERTYP"))
IF PRCFA("ERTYP")'="POREQ"
WRITE !!
DO MSG5^PRCFFERM
HANG 3
QUIT
+2 SET D0=+Y
DO STATR1^PRCFFERU(2)
+3 SET X=$PIECE($GET(RESP),U)
IF X
DO ^PRCHDP1
+4 WRITE !
SET RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
+5 SET X=$PIECE($GET(RETRAN),U)
IF 'X
DO MSG4^PRCFFERM
HANG 3
QUIT
TPO1 Begin DoDot:1
+1 SET PRCFA("RETRAN")=1
+2 SET PRCFA("PODA")=+PO
SET PCP=$PIECE(PO(0),U,3)
+3 SET $PIECE(PCP,U,2)=$SELECT($DATA(^PRC(420,PRC("SITE"),1,+PCP,0)):$PIECE(^(0),U,12),1:"")
+4 IF '$DATA(PRC("FY"))
Begin DoDot:2
+5 NEW FYQ
SET FYQ=$$FYQ^PRCFFERU(.FYQ)
+6 SET PRC("FY")=$PIECE(FYQ,U)
SET PRC("QTR")=$PIECE(FYQ,U,2)
+7 QUIT
End DoDot:2
+8 IF '$DATA(PRC("PARAM"))
SET PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
+9 NEW PRCRGS,MODDOC
SET FLG=0
+10 SET MODDOC=$PIECE($GET(PRCFA("GECS")),"^",3)
+11 SET PRCRGS=$SELECT(MODDOC="":1,MODDOC]"":2)
+12 IF MODDOC=""
DO RETRAN^PRCFFMO
QUIT
+13 IF MODDOC]""
Begin DoDot:2
+14 NEW RBLD
SET RBLD=$GET(GECSDATA(2100.1,GECSDATA,26,"E"))
+15 IF RBLD]""
SET (PRCFA("AMEND#"),PRCFAA)=$PIECE(RBLD,"/",2)
SET PRCFPODA=+PO
+16 IF RBLD=""
Begin DoDot:3
+17 SET (PRCFA("AMEND#"),X)=0
+18 FOR
SET X=$ORDER(^PRC(442,+PO,6,X))
if X'>0
QUIT
SET PRCFAA=X
+19 SET PRCFA("AMEND#")=PRCFAA
SET PRCFPODA=+PO
+20 QUIT
End DoDot:3
+21 DO SETAM
DO RETRAN^PRCFFMOM
+22 QUIT
End DoDot:2
QUIT
+23 QUIT
End DoDot:1
+24 QUIT
SETPO ;
+1 SET FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
+2 SET DESC="Purchase Order Obligation Rebuild/Transmit"
+3 if MODDOC]""
SET DESC="Purchase Order Amendment Rebuild/Transmit"
+4 DO REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
+5 SET GECSFMS("DA")=GECSDATA
+6 QUIT
SETAM ;
+1 NEW DIC
SET DIC="^PRC(442,"_+PO_",6,"
SET DIC(0)="MNZ"
SET X=PRCFA("AMEND#")
+2 DO ^DIC
IF +Y>0
SET PO(6)=Y(0)
SET PO(6,1)=^PRC(442,+PO,6,PRCFA("AMEND#"),1)
+3 QUIT
T1358 ; 1358 Error Processing when MOP = MISC OBL(1358)
+1 IF $DATA(PRCFA("ERTYP"))
IF PRCFA("ERTYP")'="MISCOBL"
WRITE !!
DO MSG5^PRCFFERM
HANG 3
QUIT
+2 DO STATR1^PRCFFERU(2)
+3 DO GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
+4 SET (OB,DA)=$GET(PRCTMP(442,+POIEN,".07","I"))
+5 DO NODE^PRCS58OB(DA,.TRNODE)
+6 IF '$DATA(PRC("CP"))
SET PRC("CP")=$PIECE(TRNODE(0),"-",4)
+7 SET X=$PIECE($GET(RESP),U)
IF X
Begin DoDot:1
+8 DO PAUSE1^PRCFFERU
+9 SET IOP="HOME"
DO ^%ZIS
DO ^PRCE58P0
+10 QUIT
End DoDot:1
+11 WRITE !
SET RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
+12 SET X=$PIECE($GET(RETRAN),U)
IF 'X
DO MSG4^PRCFFERM
HANG 3
QUIT
T13581 Begin DoDot:1
+1 SET PRCFA("RETRAN")=1
SET DA=OB
+2 IF '$DATA(PRC("FY"))
Begin DoDot:2
+3 NEW FYQ
SET FYQ=$$FYQ^PRCFFERU(.FYQ)
+4 SET PRC("FY")=$PIECE(FYQ,U)
SET PRC("QTR")=$PIECE(FYQ,U,3)
+5 QUIT
End DoDot:2
+6 IF '$DATA(PRC("PARAM"))
SET PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
+7 NEW PRCRGS,MODDOC
+8 SET MODDOC=$PIECE($GET(PRCFA("GECS")),"^",3)
+9 SET PRCRGS=$SELECT(MODDOC="":1,MODDOC]"":2)
+10 IF MODDOC=""
DO SC^PRCESOE
QUIT
+11 IF MODDOC]""
Begin DoDot:2
+12 NEW RBLD
SET RBLD=$GET(GECSDATA(2100.1,GECSDATA,26,"E"))
+13 IF RBLD]""
SET Y=$PIECE(RBLD,"/",4)
+14 IF RBLD=""
Begin DoDot:3
+15 SET PATNUM=$$STRIP^PRCFFERU(PATNUM)
+16 SET Y=$ORDER(^PRCS(410,"D",PATNUM,0))
+17 QUIT
End DoDot:3
+18 WRITE !
DO RETRAN^PRCEADJ1
QUIT
End DoDot:2
QUIT
End DoDot:1
+19 QUIT
+20 ;
SET1358 SET FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
+1 SET DESC="1358 Obligation Rebuild/Transmit"
+2 if MODDOC]""
SET DESC="1358 Obligation Adjustment Rebuild/Transmit"
+3 DO REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
+4 SET GECSFMS("DA")=GECSDATA
+5 QUIT
+6 ;
+7 ; get current txn's type, action & amendment/adjustment #
GECS NEW LOOP,NODE,X
+1 SET LOOP=0
SET PRCFA("GECS")=""
+2 FOR
SET LOOP=$ORDER(^PRC(442,+PO,10,LOOP))
if LOOP'>0!($GET(PRCFA("GECS"))'="")
QUIT
Begin DoDot:1
+3 SET NODE=^PRC(442,+PO,10,LOOP,0)
+4 IF GECSDATA(2100.1,GECSDATA,.01,"E")=$PIECE(NODE,"^",4)
Begin DoDot:2
+5 SET PRCFA("GECS")=$EXTRACT(NODE,1,2)_"^"_$EXTRACT(NODE,4)_"^"_$PIECE(NODE,"^",10)_"^"_$PIECE(NODE,"^",9)
+6 ; 1358s
IF MOP=21
SET $PIECE(PRCFA("GECS"),"^",3)=$PIECE(NODE,"^",11)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
+9 ; find all FMS txn associated with the amendment/adjustment #
+10 ; PO = purchase order ien
+11 ; VER = amendment/adjustment #
+12 ; MOP = method of processing
+13 ; returns DOC IDs for SO, AR.E, AR.M codesheets on same amend/adjust#
GETTXNS(PO,VER,MOP) NEW LOOP,NODE,PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN,TYPE,X
+1 ; piece holding amend/adjust#
SET TYPE=10
IF MOP=21
SET TYPE=11
+2 SET LOOP=0
SET (PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN)=""
+3 FOR
SET LOOP=$ORDER(^PRC(442,+PO,10,LOOP))
if LOOP'>0
QUIT
Begin DoDot:1
+4 SET NODE=^PRC(442,+PO,10,LOOP,0)
+5 IF $EXTRACT(NODE,1,4)="SO.E"
IF VER=$PIECE(NODE,"^",TYPE)
SET PRCSOE=$PIECE(NODE,"^",4)
+6 IF $EXTRACT(NODE,1,4)="SO.M"
IF VER=$PIECE(NODE,"^",TYPE)
SET PRCSOM=$PIECE(NODE,"^",4)
+7 IF $EXTRACT(NODE,1,4)="AR.E"
IF VER=$PIECE(NODE,"^",TYPE)
SET PRCARE=$PIECE(NODE,"^",4)
+8 IF $EXTRACT(NODE,1,4)="AR.M"
IF VER=$PIECE(NODE,"^",TYPE)
SET PRCARM=$PIECE(NODE,"^",4)
+9 ; canceled amend#
IF $EXTRACT(NODE,4)="X"
IF VER=$PIECE(NODE,"^",TYPE)
SET PRCCAN=1
End DoDot:1
+10 SET X=PRCSOE_"^"_PRCSOM_"^"_PRCARE_"^"_PRCARM_"^"_PRCCAN
+11 QUIT X
+12 ;
+13 ;
+14 ; Compares transaction types passed to string of existing transactions
+15 ; returns .01 field of file 2100.1 if transaction type is in string
+16 ; zero, if types are not in string
+17 ;
+18 ; TXNTP = Transaction Type
+19 ; TXNAC = Transaction Action
+20 ; STRING (Of 2100.1 doc id's) = SOE ^ SOM ^ ARE ^ ARM ^ flag for cancel
+21 ;
NEWCHK(TXNTP,TXNAC,STRING) NEW DOCID
+1 SET DOCID=0
+2 ; amend# canceled
IF $PIECE(TXNTP,"^",5)'=1
Begin DoDot:1
+3 IF $PIECE(TXNTP,":")="SO"
IF TXNAC="E"
IF $PIECE(STRING,"^",1)]""
SET DOCID=$PIECE(STRING,"^",1)
+4 IF $PIECE(TXNTP,":")="SO"
IF TXNAC="M"
IF $PIECE(STRING,"^",2)]""
SET DOCID=$PIECE(STRING,"^",2)
+5 IF $PIECE(TXNTP,":")="AR"
IF TXNAC="E"
IF $PIECE(STRING,"^",3)]""
SET DOCID=$PIECE(STRING,"^",3)
+6 IF $PIECE(TXNTP,":")="AR"
IF TXNAC="M"
IF $PIECE(STRING,"^",4)]""
SET DOCID=$PIECE(STRING,"^",4)
End DoDot:1
+7 QUIT DOCID
+8 ;
+9 ; Check the selected transaction
+10 ; if unavailable, give message & return '^'
+11 ; if available, set up GECSDATA array and return 1
SWITCH(DOCID,MP,GECSDATA) ;
+1 NEW STATUS,X
+2 DO EN^DDIOL("Document exists for "_DOCID_". Attempting to rebuild.")
+3 DO EN^DDIOL(" ")
+4 SET STATUS=$$STATUS^GECSSGET(DOCID)
+5 IF "RENT"'[$EXTRACT(STATUS)
Begin DoDot:1
+6 DO EN^DDIOL("Unable to rebuild now -- document has status of "_STATUS_".")
+7 SET X=$SELECT($EXTRACT(DOCID,1,2)="AR":"AR",MP=21:"SO",1:"MO/SO")
+8 DO EN^DDIOL("Please rebuild "_DOCID_" later using the "_X_" option.")
+9 SET X="^"
End DoDot:1
+10 IF "RENT"[$EXTRACT(STATUS)
Begin DoDot:1
+11 DO DATA^GECSSGET(DOCID,0)
+12 DO EN^DDIOL("Rebuild will continue using "_DOCID_".")
+13 SET X=1
End DoDot:1
+14 QUIT X
+15 ;
OUT KILL GECSDATA,FMSNO,STATUS,DIC,FMSSEC,DESC
+1 QUIT
SCREEN ; Control screen display
+1 IF $DATA(IOF)
WRITE @IOF
HDR ; Write Option Header
+1 IF $DATA(XQY0)
WRITE IOINHI,$PIECE(XQY0,U,2),IOINORM
+2 QUIT
