| 1 | PRCPSFR0 ;WISC/RFJ-fms regenerate and retransmit document ;28 Dec 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | N %DT,CURRDISP,DA,DATA,DATE,DATEDISP,GECSDATA,PRCPPBFY,PRCPPFCP,PRCPPSTA,PRCPWBFY,PRCPWFCP,PRCPWSTA,STACK,TRANDA,TRANDATE,TRANID,TRANNO,X,Y
|
|---|
| 6 | 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)
|
|---|
| 7 | F D Q:'STACK
|
|---|
| 8 | . S STACK=$$SELECT^GECSSTAA("IV^SV","","R","","Select Rejected IV or SV Document to Regenerate: ")
|
|---|
| 9 | . I 'STACK Q
|
|---|
| 10 | . D DATA^GECSSGET($P(STACK,"^",2),0)
|
|---|
| 11 | . S TRANID=$G(GECSDATA(2100.1,+STACK,26,"E"))
|
|---|
| 12 | . ; for earlier code sheets lookup tranid on comment line
|
|---|
| 13 | . I TRANID="" D
|
|---|
| 14 | . . I $E($P(STACK,"^",2),1,2)="SV" S TRANID=$TR($E($P(STACK,"^",2),7,12)," ") Q
|
|---|
| 15 | . . S TRANID=$E($P($G(GECSDATA(2100.1,+STACK,4,"E")),":",3),2,99)
|
|---|
| 16 | . S DATA=""
|
|---|
| 17 | . I TRANID'="" S DATA=$G(^PRCP(445.2,+$O(^PRCP(445.2,"T",PRCP("I"),TRANID,0)),0))
|
|---|
| 18 | . 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
|
|---|
| 19 | . S (DATE,TRANDATE)=$P(DATA,"^",3),TRANNO=$P(DATA,"^",19) I TRANNO'="" S TRANDA=+$O(^PRCS(410,"B",TRANNO,0))
|
|---|
| 20 | . ; if transaction date does not equal current date, ask date
|
|---|
| 21 | . I $E(DATE,1,5)'=$E(DT,1,5) F D Q:Y'=0
|
|---|
| 22 | . . S Y=DT D DD^%DT S CURRDISP=Y,Y=DATE D DD^%DT S DATEDISP=Y
|
|---|
| 23 | . . K X S X(1)=" *** W A R N I N G ***" W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 24 | . . 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_". "
|
|---|
| 25 | . . 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)_"."
|
|---|
| 26 | . . D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 27 | . . S %DT="AEP",%DT("A")="Select FMS Accounting Date: ",%DT("B")=DATEDISP,%DT(0)=DATE D ^%DT I Y<0 S TRANDATE=0 Q
|
|---|
| 28 | . . 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
|
|---|
| 29 | . . S TRANDATE=Y D DD^%DT
|
|---|
| 30 | . . K X S X(1)="OKAY, I will use "_Y_" as the FMS accounting period."
|
|---|
| 31 | . . 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)_"."
|
|---|
| 32 | . . W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 33 | . ;
|
|---|
| 34 | . I 'TRANDATE Q
|
|---|
| 35 | . 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."
|
|---|
| 36 | . E S XP="READY TO REBUILD FMS CODE SHEET",XH="Enter YES to rebuild and retransmit the FMS code sheet."
|
|---|
| 37 | . W ! I $$YN^PRCPUYN(2)'=1 Q
|
|---|
| 38 | . ; rebuild sv
|
|---|
| 39 | . I $E($P(STACK,"^",2),1,2)="SV" D SVDATA^PRCPSFIU(PRCP("I")),SV^PRCPSFSV(PRCP("I"),TRANID,TRANDATE,+STACK) Q
|
|---|
| 40 | . ; rebuild iv
|
|---|
| 41 | . D IVDATA^PRCPSFIU(TRANDA,PRCP("I"))
|
|---|
| 42 | . D IV^PRCPSFIV(PRCP("I"),TRANID,TRANNO,TRANDATE,+STACK)
|
|---|
| 43 | Q
|
|---|
