- 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 Feb 18, 2025@23:42:08 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