| 1 | PRCEADJ ;WISC/CLH/LDB/PLT/SJG-CP 1358 ADJUSTMENTS ; 04/21/93 10:52 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;Create increase/decrease adjustment
|
|---|
| 5 | EN N PRC410,PRC442,PRCS,DIE,DR,PRC,PRCS2,DIC,X,X410,X442,X1,X2,X3,X4,PRCSIP,Y,Y410,DIR,TRNODE,Z,Z410,PRCSOBN
|
|---|
| 6 | EN1 ;
|
|---|
| 7 | D EN^PRCSUT ; ask site, fiscal year, quarter, control point; set X & Z
|
|---|
| 8 | I '$D(PRC("SITE")) W !,$C(7),"You are not an authorized control point user.",! G OUT
|
|---|
| 9 | G OUT:'$D(PRC("QTR"))!(Y<0)
|
|---|
| 10 | S X410=X ; station-FY-FCP
|
|---|
| 11 | S Z410=Z ; station-FY-quarter-FCP
|
|---|
| 12 | ENA1 S DIC=410,Y=""
|
|---|
| 13 | D OROBL^PRCS58OB(DIC,.PRC,.Y) ; get obligation # from old 1358
|
|---|
| 14 | I $D(DTOUT)!$D(DUOUT) G OUT
|
|---|
| 15 | I Y<0 W $C(7),!!," Obligation number is required. Use '^' to exit this option.",! G ENA1
|
|---|
| 16 | S Y410=Y
|
|---|
| 17 | S X442=X
|
|---|
| 18 | D NODE^PRCS58OB(+Y,.TRNODE) ; set up TRNODE array from data in 410
|
|---|
| 19 | S X="0101"_$P(TRNODE(0),"-",2),%DT="X" D ^%DT
|
|---|
| 20 | S X2=$E(Y,1,3) ; FY of original 1358
|
|---|
| 21 | S X="0101"_PRC("FY"),%DT="X" D ^%DT
|
|---|
| 22 | S X3=$E(Y,1,3) ; adjustment FY
|
|---|
| 23 | I X2_"-"_$P(TRNODE(0),"-",3)](X3_"-"_PRC("QTR")) D EN^DDIOL("Adjustments cannot be earlier than the original 1358's FY-QTR.") G ENA1
|
|---|
| 24 | N POOBL S POOBL=$P($G(TRNODE(10)),U,3)
|
|---|
| 25 | I POOBL="" D EN^DDIOL(" Obligation number is required.") W ! G ENA1
|
|---|
| 26 | N OBLSTAT S OBLSTAT=$$NP^PRC0B("^PRC(442,"_POOBL_",",7,1)
|
|---|
| 27 | I $G(OBLSTAT)=40 D EN^DDIOL(" Adjusting a closed 1358 request is not allowed.") W ! G ENA1
|
|---|
| 28 | ENA2 N EXIT S EXIT=0
|
|---|
| 29 | D FMSTAT(POOBL,.FMSDOC,.STATUS)
|
|---|
| 30 | I $D(STATUS),"AF"'[$E(STATUS,1) D I EXIT D MSG1,OUT G EN1
|
|---|
| 31 | .Q:STATUS="CALM"
|
|---|
| 32 | .; S TMP=Y,%X="Y",%Y="TMP(" D %XY^%RCR K %X,%Y ; PRC*5*231 - saves Y earlier
|
|---|
| 33 | .K MSG W !
|
|---|
| 34 | .S MSG(1)=" Note that one of the previous documents has not been processed in FMS."
|
|---|
| 35 | .S MSG(2)=" The adjustment to this 1358 cannot be obligated until the previous"
|
|---|
| 36 | .S MSG(3)=" document has been processed in FMS.",MSG(5)=" "
|
|---|
| 37 | .S MSG(6)=" FMS Document: "_FMSDOC,MSG(7)=" Status: "_STATUS
|
|---|
| 38 | .D EN^DDIOL(.MSG) K MSG
|
|---|
| 39 | .W ! D PROMPT
|
|---|
| 40 | .S:Y EXIT=0 I 'Y!($D(DIRUT)) S EXIT=1
|
|---|
| 41 | .Q
|
|---|
| 42 | ;The following lines commented out by PRC*5*231 - Y doesn't need to be restored
|
|---|
| 43 | ; I $D(STATUS) S:"AF"[$E(STATUS,1)!(STATUS="CALM") EXIT=1
|
|---|
| 44 | ENA3 ; I $D(EXIT) I 'EXIT S Y=TMP,%X="TMP",%Y="Y(" D %XY^%RCR,MSG2 K TMP,%X,%Y
|
|---|
| 45 | S PRC442=$P($G(TRNODE(10)),U,3)
|
|---|
| 46 | S PRCSOBN=$$BAL^PRCH58(PRC442) ; get obligation# from file 442,node 8
|
|---|
| 47 | I PRCSOBN'=-1 W !," Original Obligation Amount: $ ",$FN($P(PRCSOBN,U),",P",2)
|
|---|
| 48 | I PRCSOBN'=-1 D
|
|---|
| 49 | .W ?46,"Service Balance: $ ",$FN((+PRCSOBN-$P(PRCSOBN,U,3)),",P",2),!
|
|---|
| 50 | .W ?4," Fiscal's 1358 Balance: $ ",$FN(+PRCSOBN-$P(PRCSOBN,U,2),",P",2),!
|
|---|
| 51 | S Y=Y410,X=X410,X1=X,Z=Z410
|
|---|
| 52 | D EN1^PRCSUT3 Q:'X S X1=X
|
|---|
| 53 | D EN2^PRCSUT3 Q:'$D(X1) S X=X1 ; add data to record in 410
|
|---|
| 54 | W !,"This transaction is assigned transaction number: ",X
|
|---|
| 55 | L +^PRCS(410,DA):0 I $T=0 D EN^DDIOL("File in use.... Please try again later") D KILL G EN1
|
|---|
| 56 | I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)) S:$P(^(0),U,11)="Y" PRCS2=1
|
|---|
| 57 | S PRC410=DA
|
|---|
| 58 | S PRCSIP=$S($D(PRCSIP):PRCSIP,1:"")
|
|---|
| 59 | D ADJ^PRCS58OB(DIC,DA,PRCSIP,.X4)
|
|---|
| 60 | K PRCSOBN
|
|---|
| 61 | D ADJ1^PRCS58OB(DA,X,Y410)
|
|---|
| 62 | D ADJ2^PRCS58OB(.PRC,X442,DA)
|
|---|
| 63 | L -^PRCS(410,DA)
|
|---|
| 64 | S DIR("A")="Enter another increase/decrease adjustment"
|
|---|
| 65 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 66 | S DIR("?")="Yes to enter an adjustment, return or '^' to quit"
|
|---|
| 67 | D ^DIR I Y D KILL G EN1
|
|---|
| 68 | OUT K DIRUT,DTOUT,DUOUT
|
|---|
| 69 | KILL K PRC410,PRC442,PRCS,DIE,DR,PRC,PRCSL,PRCS2,DIC,X,X410,X442,X1,X4,PRCSIP,Y,Y410,DIR,TRNODE,Z,Z410,PRCSOBN
|
|---|
| 70 | K DA,FMSDOC,STATUS,TMP
|
|---|
| 71 | QUIT
|
|---|
| 72 | ;
|
|---|
| 73 | ASK ; entry point from other options
|
|---|
| 74 | S DIR(0)="YO"
|
|---|
| 75 | S DIR("A")="Do you want to enter an increase adjustment at this time"
|
|---|
| 76 | S DIR("B")="NO"
|
|---|
| 77 | S DIR("?")="Yes to enter an increase adjustment, return or '^' to quit"
|
|---|
| 78 | D ^DIR I 'Y&'$D(DIRUT) W !!,"No action can be taken with this authorization amount now.",! K DIR Q
|
|---|
| 79 | K DIR,DIC,X,Y I $D(DIRUT) Q
|
|---|
| 80 | G EN
|
|---|
| 81 | ;
|
|---|
| 82 | FMSTAT(POOBL,FMSDOC,STATUS) ; Check status of prior FMS Documents
|
|---|
| 83 | N LOOP,NODE
|
|---|
| 84 | S LOOP=0,(FMSDOC,STATUS)=""
|
|---|
| 85 | F S LOOP=$O(^PRC(442,+POOBL,10,LOOP)) Q:LOOP'>0 D
|
|---|
| 86 | .S NODE=^PRC(442,+POOBL,10,LOOP,0)
|
|---|
| 87 | .I $E(NODE,1,2)="SO"!($E(NODE,1,2)="AR") D
|
|---|
| 88 | ..S FMSDOC=$P($G(^PRC(442,+POOBL,10,LOOP,0)),U,4)
|
|---|
| 89 | ..S STATUS=$$STATUS^GECSSGET(FMSDOC)
|
|---|
| 90 | ..Q
|
|---|
| 91 | .I $E(NODE,1,6)?3N1"."2N S STATUS="CALM"
|
|---|
| 92 | Q
|
|---|
| 93 | PROMPT ;
|
|---|
| 94 | S DIR(0)="Y"
|
|---|
| 95 | S DIR("A")=" Do you wish to create the adjustment to this 1358"
|
|---|
| 96 | S DIR("B")="YES"
|
|---|
| 97 | S DIR("?")=" Enter 'YES' or 'Y' or 'RETURN' to create the adjustment."
|
|---|
| 98 | S DIR("?",1)=" Enter 'NO' or 'N' or '^' to exit."
|
|---|
| 99 | D ^DIR K DIR
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | MSG1 W ! D EN^DDIOL(" No further action taken on this adjustment.") W ! Q
|
|---|
| 103 | MSG2 W ! D EN^DDIOL(" Returning to creating the 1358 adjustment...") W !! Q
|
|---|
