PRCFFER.m

PRCFFER ;WISC/SJG-OBLIGATION ERROR PROCESSING ;6/3/94  9:25 AM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 QUIT

 ; No top level entry

TPOI ; Entry point for Purchase Orders Inquiry

 D HILO^PRCFQ,SCREEN

 S TXT1="Purchase Order Number",PRCFA("ERROR")=0,PRCFA("ERTYP")="POREQ"

 S TXT2="Select Stack Document for Inquiry: "

 D EN^PRC0E("MO:Miscellaneous Order;SO:Service Order^"_TXT2,"D TYPE^PRCFFERI(.X)")

 D OUT

 QUIT

TPOR ; Entry point for Purchase Order Rebuild/Retransmit

 D HILO^PRCFQ,SCREEN

 S TXT1="Purchase Order Number",PRCFA("ERROR")=0,PRCFA("ERTYP")="POREQ"

 S TXT2="Select Stack Document for Rebuild/Retransmit: "

 D EN^PRC0E("MO:Miscellaneous Order;SO:Service Order^"_TXT2_"^~R~N~E~T~~^","D TYPE^PRCFFERT(.X)")

 D OUT

 QUIT

T1358I ; Entry point for 1358 Inquiry

 D HILO^PRCFQ,SCREEN

 S TXT1="1358 Obligation Number",PRCFA("ERROR")=0,PRCFA("ERTYP")="MISCOBL"

 S TXT2="Select Stack Document for Inquiry: "

 D EN^PRC0E("SO:Service Order^"_TXT2,"D TYPE^PRCFFERI(.X)")

 D OUT

 QUIT

T1358R ; Entry point for 1358 Rebuild/Retransmit

 D HILO^PRCFQ,SCREEN

 S TXT1="1358 Obligation Number",PRCFA("ERROR")=0,PRCFA("ERTYP")="MISCOBL"

 S TXT2="Select Stack Document for Rebuild/Transmit: "

 D EN^PRC0E("SO:Service Order^"_TXT2_"^~R~E~N~T~~^","D TYPE^PRCFFERT(.X)")

 D OUT

 QUIT

 ;

 ; Entry point for Inquiry for AR documents

TARI D HILO^PRCFQ,SCREEN

 S TXT1="Purchase Order/Obligation Number",PRCFA("ERROR")=0

 S TXT2="Select Stack Document for Inquiry: "

 D EN^PRC0E("AR:Receiver Accrual^"_TXT2,"D TYPE^PRCFFERI(.X)")

 D OUT

 QUIT

 ; Entry point for Rebuild/Retransmit AR documents

TARR D HILO^PRCFQ,SCREEN

 S TXT1="AR Number",PRCFA("ERROR")=0

 S TXT2="Select Stack Document for Rebuild/Retransmit: "

 D EN^PRC0E("AR:Receiver Accrual^"_TXT2_"^~R~E~N~T~~^","D TYPE^PRCFFERT(.X)")

 D OUT

 QUIT

 ;

OUT K GECSDATA,FMSNO,STATUS,DIC,PATNUM,PONUM,MOP,LOOP,POIEN,TXT1,TXT2

 K PRCFA,IOINHI,IOINLOW,IOINORM

 Q

SCREEN ; Control screen display;

 I $D(IOF) W @IOF

HDR ; Write Option Header

 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFFER   2130     printed  Apr 09, 2024@21:10:44                                                                                                                                                                                                     Page 2

PRCFFER   ;WISC/SJG-OBLIGATION ERROR PROCESSING ;6/3/94  9:25 AM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2        QUIT 

 +3       ; No top level entry

TPOI      ; Entry point for Purchase Orders Inquiry

 +1        DO HILO^PRCFQ

           DO SCREEN

 +2        SET TXT1="Purchase Order Number"

           SET PRCFA("ERROR")=0

           SET PRCFA("ERTYP")="POREQ"

 +3        SET TXT2="Select Stack Document for Inquiry: "

 +4        DO EN^PRC0E("MO:Miscellaneous Order;SO:Service Order^"_TXT2,"D TYPE^PRCFFERI(.X)")

 +5        DO OUT

 +6        QUIT 

TPOR      ; Entry point for Purchase Order Rebuild/Retransmit

 +1        DO HILO^PRCFQ

           DO SCREEN

 +2        SET TXT1="Purchase Order Number"

           SET PRCFA("ERROR")=0

           SET PRCFA("ERTYP")="POREQ"

 +3        SET TXT2="Select Stack Document for Rebuild/Retransmit: "

 +4        DO EN^PRC0E("MO:Miscellaneous Order;SO:Service Order^"_TXT2_"^~R~N~E~T~~^","D TYPE^PRCFFERT(.X)")

 +5        DO OUT

 +6        QUIT 

T1358I    ; Entry point for 1358 Inquiry

 +1        DO HILO^PRCFQ

           DO SCREEN

 +2        SET TXT1="1358 Obligation Number"

           SET PRCFA("ERROR")=0

           SET PRCFA("ERTYP")="MISCOBL"

 +3        SET TXT2="Select Stack Document for Inquiry: "

 +4        DO EN^PRC0E("SO:Service Order^"_TXT2,"D TYPE^PRCFFERI(.X)")

 +5        DO OUT

 +6        QUIT 

T1358R    ; Entry point for 1358 Rebuild/Retransmit

 +1        DO HILO^PRCFQ

           DO SCREEN

 +2        SET TXT1="1358 Obligation Number"

           SET PRCFA("ERROR")=0

           SET PRCFA("ERTYP")="MISCOBL"

 +3        SET TXT2="Select Stack Document for Rebuild/Transmit: "

 +4        DO EN^PRC0E("SO:Service Order^"_TXT2_"^~R~E~N~T~~^","D TYPE^PRCFFERT(.X)")

 +5        DO OUT

 +6        QUIT 

 +7       ;

 +8       ; Entry point for Inquiry for AR documents

TARI       DO HILO^PRCFQ

           DO SCREEN

 +1        SET TXT1="Purchase Order/Obligation Number"

           SET PRCFA("ERROR")=0

 +2        SET TXT2="Select Stack Document for Inquiry: "

 +3        DO EN^PRC0E("AR:Receiver Accrual^"_TXT2,"D TYPE^PRCFFERI(.X)")

 +4        DO OUT

 +5        QUIT 

 +6       ; Entry point for Rebuild/Retransmit AR documents

TARR       DO HILO^PRCFQ

           DO SCREEN

 +1        SET TXT1="AR Number"

           SET PRCFA("ERROR")=0

 +2        SET TXT2="Select Stack Document for Rebuild/Retransmit: "

 +3        DO EN^PRC0E("AR:Receiver Accrual^"_TXT2_"^~R~E~N~T~~^","D TYPE^PRCFFERT(.X)")

 +4        DO OUT

 +5        QUIT 

 +6       ;

OUT        KILL GECSDATA,FMSNO,STATUS,DIC,PATNUM,PONUM,MOP,LOOP,POIEN,TXT1,TXT2

 +1        KILL PRCFA,IOINHI,IOINLOW,IOINORM

 +2        QUIT 

SCREEN    ; Control screen display;

 +1        IF $DATA(IOF)

               WRITE @IOF

HDR       ; Write Option Header

 +1        IF $DATA(XQY0)

               WRITE IOINHI,$PIECE(XQY0,U,2),IOINORM

 +2        QUIT