PRCPSFR0 ;WISC/RFJ-fms regenerate and retransmit document ;28 Dec 94
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
N %DT,CURRDISP,DA,DATA,DATE,DATEDISP,GECSDATA,PRCPPBFY,PRCPPFCP,PRCPPSTA,PRCPWBFY,PRCPWFCP,PRCPWSTA,STACK,TRANDA,TRANDATE,TRANID,TRANNO,X,Y
K X S X(1)="This option will regenerate and retransmit a rejected FMS document from the Generic Code Sheet Stack File." W ! D DISPLAY^PRCPUX2(40,79,.X)
F D Q:'STACK
. S STACK=$$SELECT^GECSSTAA("IV^SV","","R","","Select Rejected IV or SV Document to Regenerate: ")
. I 'STACK Q
. D DATA^GECSSGET($P(STACK,"^",2),0)
. S TRANID=$G(GECSDATA(2100.1,+STACK,26,"E"))
. ; for earlier code sheets lookup tranid on comment line
. I TRANID="" D
. . I $E($P(STACK,"^",2),1,2)="SV" S TRANID=$TR($E($P(STACK,"^",2),7,12)," ") Q
. . S TRANID=$E($P($G(GECSDATA(2100.1,+STACK,4,"E")),":",3),2,99)
. S DATA=""
. I TRANID'="" S DATA=$G(^PRCP(445.2,+$O(^PRCP(445.2,"T",PRCP("I"),TRANID,0)),0))
. I DATA="" K X S X(1)="ERROR: Unable to find the transaction register entry '"_TRANID_"'. Unable to rebuild the FMS code sheets." D DISPLAY^PRCPUX2(5,75,.X) Q
. S (DATE,TRANDATE)=$P(DATA,"^",3),TRANNO=$P(DATA,"^",19) I TRANNO'="" S TRANDA=+$O(^PRCS(410,"B",TRANNO,0))
. ; if transaction date does not equal current date, ask date
. I $E(DATE,1,5)'=$E(DT,1,5) F D Q:Y'=0
. . S Y=DT D DD^%DT S CURRDISP=Y,Y=DATE D DD^%DT S DATEDISP=Y
. . K X S X(1)=" *** W A R N I N G ***" W ! D DISPLAY^PRCPUX2(5,75,.X)
. . K X S X(1)="This transaction was processed in inventory on "_DATEDISP_". Since this transaction was processed in a prior month-year, you have the option to process this transaction in FMS for "_DATEDISP_" or "_CURRDISP_". "
. . S X(2)="If you select to process this transaction in FMS for "_CURRDISP_", reconciliation between inventory and FMS will be different for both months "_$E(DATEDISP,1,3)_$E(DATEDISP,8,12)_" and "_$E(CURRDISP,1,3)_$E(CURRDISP,8,12)_"."
. . D DISPLAY^PRCPUX2(5,75,.X)
. . S %DT="AEP",%DT("A")="Select FMS Accounting Date: ",%DT("B")=DATEDISP,%DT(0)=DATE D ^%DT I Y<0 S TRANDATE=0 Q
. . I Y'=DT,Y'=DATE K X S X(1)="ERROR: Only the dates "_DATEDISP_" and "_CURRDISP_" are selectable." D DISPLAY^PRCPUX2(5,75,.X) S Y=0 Q
. . S TRANDATE=Y D DD^%DT
. . K X S X(1)="OKAY, I will use "_Y_" as the FMS accounting period."
. . I TRANDATE'=DATE S X(2)=" Please make a note of this transaction since reconciliation between inventory and FMS will be different for the months "_$E(DATEDISP,1,3)_$E(DATEDISP,8,12)_" and "_$E(CURRDISP,1,3)_$E(CURRDISP,8,12)_"."
. . W ! D DISPLAY^PRCPUX2(5,75,.X)
. ;
. I 'TRANDATE Q
. I $E(DATE,1,5)'=$E(TRANDATE,1,5) S XP="ARE YOU SURE",XH="Enter YES to rebuild this transaction for different month-years."
. E S XP="READY TO REBUILD FMS CODE SHEET",XH="Enter YES to rebuild and retransmit the FMS code sheet."
. W ! I $$YN^PRCPUYN(2)'=1 Q
. ; rebuild sv
. I $E($P(STACK,"^",2),1,2)="SV" D SVDATA^PRCPSFIU(PRCP("I")),SV^PRCPSFSV(PRCP("I"),TRANID,TRANDATE,+STACK) Q
. ; rebuild iv
. D IVDATA^PRCPSFIU(TRANDA,PRCP("I"))
. D IV^PRCPSFIV(PRCP("I"),TRANID,TRANNO,TRANDATE,+STACK)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSFR0 3362 printed Sep 23, 2025@19:51:50 Page 2
PRCPSFR0 ;WISC/RFJ-fms regenerate and retransmit document ;28 Dec 94
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 NEW %DT,CURRDISP,DA,DATA,DATE,DATEDISP,GECSDATA,PRCPPBFY,PRCPPFCP,PRCPPSTA,PRCPWBFY,PRCPWFCP,PRCPWSTA,STACK,TRANDA,TRANDATE,TRANID,TRANNO,X,Y
+5 KILL X
SET X(1)="This option will regenerate and retransmit a rejected FMS document from the Generic Code Sheet Stack File."
WRITE !
DO DISPLAY^PRCPUX2(40,79,.X)
+6 FOR
Begin DoDot:1
+7 SET STACK=$$SELECT^GECSSTAA("IV^SV","","R","","Select Rejected IV or SV Document to Regenerate: ")
+8 IF 'STACK
QUIT
+9 DO DATA^GECSSGET($PIECE(STACK,"^",2),0)
+10 SET TRANID=$GET(GECSDATA(2100.1,+STACK,26,"E"))
+11 ; for earlier code sheets lookup tranid on comment line
+12 IF TRANID=""
Begin DoDot:2
+13 IF $EXTRACT($PIECE(STACK,"^",2),1,2)="SV"
SET TRANID=$TRANSLATE($EXTRACT($PIECE(STACK,"^",2),7,12)," ")
QUIT
+14 SET TRANID=$EXTRACT($PIECE($GET(GECSDATA(2100.1,+STACK,4,"E")),":",3),2,99)
End DoDot:2
+15 SET DATA=""
+16 IF TRANID'=""
SET DATA=$GET(^PRCP(445.2,+$ORDER(^PRCP(445.2,"T",PRCP("I"),TRANID,0)),0))
+17 IF DATA=""
KILL X
SET X(1)="ERROR: Unable to find the transaction register entry '"_TRANID_"'. Unable to rebuild the FMS code sheets."
DO DISPLAY^PRCPUX2(5,75,.X)
QUIT
+18 SET (DATE,TRANDATE)=$PIECE(DATA,"^",3)
SET TRANNO=$PIECE(DATA,"^",19)
IF TRANNO'=""
SET TRANDA=+$ORDER(^PRCS(410,"B",TRANNO,0))
+19 ; if transaction date does not equal current date, ask date
+20 IF $EXTRACT(DATE,1,5)'=$EXTRACT(DT,1,5)
FOR
Begin DoDot:2
+21 SET Y=DT
DO DD^%DT
SET CURRDISP=Y
SET Y=DATE
DO DD^%DT
SET DATEDISP=Y
+22 KILL X
SET X(1)=" *** W A R N I N G ***"
WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
+23 KILL X
SET X(1)="This transaction was processed in inventory on "_DATEDISP_". Since this transaction was processed in a prior month-year, you have the option to process this transaction in FMS for "_DATEDISP_" or "_CURRDISP_". "
+24 SET X(2)="If you select to process this transaction in FMS for "_CURRDISP_", reconciliation between inventory and FMS will be different for both months "_$EXTRACT(DATEDISP,1,3)_$EXTRACT(DATEDISP,8,12)_" and "_$EXTRACT(CURRDIS
P,1,3)_...
... $EXTRACT(CURRDISP,8,12)_"."
+25 DO DISPLAY^PRCPUX2(5,75,.X)
+26 SET %DT="AEP"
SET %DT("A")="Select FMS Accounting Date: "
SET %DT("B")=DATEDISP
SET %DT(0)=DATE
DO ^%DT
IF Y<0
SET TRANDATE=0
QUIT
+27 IF Y'=DT
IF Y'=DATE
KILL X
SET X(1)="ERROR: Only the dates "_DATEDISP_" and "_CURRDISP_" are selectable."
DO DISPLAY^PRCPUX2(5,75,.X)
SET Y=0
QUIT
+28 SET TRANDATE=Y
DO DD^%DT
+29 KILL X
SET X(1)="OKAY, I will use "_Y_" as the FMS accounting period."
+30 IF TRANDATE'=DATE
SET X(2)=" Please make a note of this transaction since reconciliation between inventory and FMS will be different for the months "_$EXTRACT(DATEDISP,1,3)_$EXTRACT(DATEDISP,8,12)_" and "_$EXTRACT(CURRDISP,1,3)_$EXTRACT(C
URRDISP,8,12)_"."
+31 WRITE !
DO DISPLAY^PRCPUX2(5,75,.X)
End DoDot:2
if Y'=0
QUIT
+32 ;
+33 IF 'TRANDATE
QUIT
+34 IF $EXTRACT(DATE,1,5)'=$EXTRACT(TRANDATE,1,5)
SET XP="ARE YOU SURE"
SET XH="Enter YES to rebuild this transaction for different month-years."
+35 IF '$TEST
SET XP="READY TO REBUILD FMS CODE SHEET"
SET XH="Enter YES to rebuild and retransmit the FMS code sheet."
+36 WRITE !
IF $$YN^PRCPUYN(2)'=1
QUIT
+37 ; rebuild sv
+38 IF $EXTRACT($PIECE(STACK,"^",2),1,2)="SV"
DO SVDATA^PRCPSFIU(PRCP("I"))
DO SV^PRCPSFSV(PRCP("I"),TRANID,TRANDATE,+STACK)
QUIT
+39 ; rebuild iv
+40 DO IVDATA^PRCPSFIU(TRANDA,PRCP("I"))
+41 DO IV^PRCPSFIV(PRCP("I"),TRANID,TRANNO,TRANDATE,+STACK)
End DoDot:1
if 'STACK
QUIT
+42 QUIT
