PRCEADJ ;WISC/CLH/LDB/PLT/SJG-CP 1358 ADJUSTMENTS ; 04/21/93  10:52 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;Create increase/decrease adjustment
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
EN1 ;
 D EN^PRCSUT ; ask site, fiscal year, quarter, control point; set X & Z
 I '$D(PRC("SITE")) W !,$C(7),"You are not an authorized control point user.",! G OUT
 G OUT:'$D(PRC("QTR"))!(Y<0)
 S X410=X ; station-FY-FCP
 S Z410=Z ; station-FY-quarter-FCP
ENA1 S DIC=410,Y=""
 D OROBL^PRCS58OB(DIC,.PRC,.Y) ; get obligation # from old 1358
 I $D(DTOUT)!$D(DUOUT) G OUT
 I Y<0 W $C(7),!!,"    Obligation number is required.  Use '^' to exit this option.",! G ENA1
 S Y410=Y
 S X442=X
 D NODE^PRCS58OB(+Y,.TRNODE) ; set up TRNODE array from data in 410
 S X="0101"_$P(TRNODE(0),"-",2),%DT="X" D ^%DT
 S X2=$E(Y,1,3) ; FY of original 1358
 S X="0101"_PRC("FY"),%DT="X" D ^%DT
 S X3=$E(Y,1,3) ; adjustment FY
 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
 N POOBL S POOBL=$P($G(TRNODE(10)),U,3)
 I POOBL="" D EN^DDIOL("    Obligation number is required.") W ! G ENA1
 N OBLSTAT S OBLSTAT=$$NP^PRC0B("^PRC(442,"_POOBL_",",7,1)
 I $G(OBLSTAT)=40 D EN^DDIOL("    Adjusting a closed 1358 request is not allowed.") W ! G ENA1
ENA2 N EXIT S EXIT=0
 D FMSTAT(POOBL,.FMSDOC,.STATUS)
 I $D(STATUS),"AF"'[$E(STATUS,1) D  I EXIT D MSG1,OUT G EN1
 .Q:STATUS="CALM"
 .; S TMP=Y,%X="Y",%Y="TMP(" D %XY^%RCR K %X,%Y ; PRC*5*231 - saves Y earlier
 .K MSG W !
 .S MSG(1)="    Note that one of the previous documents has not been processed in FMS."
 .S MSG(2)="    The adjustment to this 1358 cannot be obligated until the previous"
 .S MSG(3)="    document has been processed in FMS.",MSG(5)="  "
 .S MSG(6)="    FMS Document: "_FMSDOC,MSG(7)="    Status: "_STATUS
 .D EN^DDIOL(.MSG) K MSG
 .W ! D PROMPT
 .S:Y EXIT=0 I 'Y!($D(DIRUT)) S EXIT=1
 .Q
 ;The following lines commented out by PRC*5*231 - Y doesn't need to be restored
 ; I $D(STATUS) S:"AF"[$E(STATUS,1)!(STATUS="CALM") EXIT=1
ENA3 ; I $D(EXIT) I 'EXIT S Y=TMP,%X="TMP",%Y="Y(" D %XY^%RCR,MSG2 K TMP,%X,%Y
 S PRC442=$P($G(TRNODE(10)),U,3)
 S PRCSOBN=$$BAL^PRCH58(PRC442) ; get obligation# from file 442,node 8
 I PRCSOBN'=-1 W !," Original Obligation Amount:  $ ",$FN($P(PRCSOBN,U),",P",2)
 I PRCSOBN'=-1 D
 .W ?46,"Service Balance: $ ",$FN((+PRCSOBN-$P(PRCSOBN,U,3)),",P",2),!
 .W ?4,"  Fiscal's 1358 Balance:  $ ",$FN(+PRCSOBN-$P(PRCSOBN,U,2),",P",2),!
 S Y=Y410,X=X410,X1=X,Z=Z410
 D EN1^PRCSUT3 Q:'X  S X1=X
 D EN2^PRCSUT3 Q:'$D(X1)  S X=X1 ; add data to record in 410
 W !,"This transaction is assigned transaction number: ",X
 L +^PRCS(410,DA):0 I $T=0 D EN^DDIOL("File in use.... Please try again later") D KILL G EN1
 I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)) S:$P(^(0),U,11)="Y" PRCS2=1
 S PRC410=DA
 S PRCSIP=$S($D(PRCSIP):PRCSIP,1:"")
 D ADJ^PRCS58OB(DIC,DA,PRCSIP,.X4)
 K PRCSOBN
 D ADJ1^PRCS58OB(DA,X,Y410)
 D ADJ2^PRCS58OB(.PRC,X442,DA)
 L -^PRCS(410,DA)
 S DIR("A")="Enter another increase/decrease adjustment"
 S DIR(0)="YO",DIR("B")="NO"
 S DIR("?")="Yes to enter an adjustment, return or '^' to quit"
 D ^DIR I Y D KILL G EN1
OUT K DIRUT,DTOUT,DUOUT
KILL K PRC410,PRC442,PRCS,DIE,DR,PRC,PRCSL,PRCS2,DIC,X,X410,X442,X1,X4,PRCSIP,Y,Y410,DIR,TRNODE,Z,Z410,PRCSOBN
 K DA,FMSDOC,STATUS,TMP
 QUIT
 ;
ASK ; entry point from other options
 S DIR(0)="YO"
 S DIR("A")="Do you want to enter an increase adjustment at this time"
 S DIR("B")="NO"
 S DIR("?")="Yes to enter an increase adjustment, return or '^' to quit"
 D ^DIR I 'Y&'$D(DIRUT) W !!,"No action can be taken with this authorization amount now.",! K DIR Q
 K DIR,DIC,X,Y I $D(DIRUT) Q
 G EN
 ;
FMSTAT(POOBL,FMSDOC,STATUS) ; Check status of prior FMS Documents
 N LOOP,NODE
 S LOOP=0,(FMSDOC,STATUS)=""
 F  S LOOP=$O(^PRC(442,+POOBL,10,LOOP)) Q:LOOP'>0  D
 .S NODE=^PRC(442,+POOBL,10,LOOP,0)
 .I $E(NODE,1,2)="SO"!($E(NODE,1,2)="AR") D
 ..S FMSDOC=$P($G(^PRC(442,+POOBL,10,LOOP,0)),U,4)
 ..S STATUS=$$STATUS^GECSSGET(FMSDOC)
 ..Q
 .I $E(NODE,1,6)?3N1"."2N S STATUS="CALM"
 Q
PROMPT ;
 S DIR(0)="Y"
 S DIR("A")="    Do you wish to create the adjustment to this 1358"
 S DIR("B")="YES"
 S DIR("?")="    Enter 'YES' or 'Y' or 'RETURN' to create the adjustment."
 S DIR("?",1)="    Enter 'NO' or 'N' or '^' to exit."
 D ^DIR K DIR
 Q
 ;
MSG1 W ! D EN^DDIOL("    No further action taken on this adjustment.") W ! Q
MSG2 W ! D EN^DDIOL("    Returning to creating the 1358 adjustment...") W !! Q