PRCFA921.m

PRCFA921 ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY 921.00 OBLIGATION TRANSACTION ;8/26/93  1:27 PM

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

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

 D HILO^PRCFQ

DJ ;RESERVED FOR CODE TO CALL A SCREEN HANDLER

LOAD Q:'$D(^PRCF(423,DA))  S X=^PRCF(423,DA,0),X1=^(1)

SE S $P(SP," ",80)=""

 W:$D(IOF) @IOF W !,IOINLOW,$E(SP,1,5),"OBLIGATION NUMBER: ",IOINHI,$P(X,"^",6),IOINLOW,$E(SP,1,10),"CODE SHEET #: ",IOINHI,PRCFA("CSNAME")

 W !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,$P(X,"^",4),IOINLOW,"    TRANSACTION DATE: ",IOINHI,$P(X,"^",5),IOINLOW,"       REF #: ",IOINHI,$P(X,"^",6)

 W !,IOINLOW," YALD CODE: ",IOINHI,$E($P(X1,"^")_"     ",1,6),IOINLOW,$E(SP,1,6),"DEL MONTH: ",IOINHI

 W $S(PRCFA("EDIT")'["921.60":$P(X1,"^",2),1:$P(X,"^",9)),IOINLOW,$E(SP,1,6),"S/C: ",IOINHI,$P(X1,"^",3),IOINLOW,$E(SP,1,6),"DEL DATE: ",IOINHI,$P(X1,"^",4)

 W !,$E(SP,1,4),IOINLOW,"CONTROL POINT: ",IOINHI,$E($P(X1,"^",5)_"    ",1,4),IOINLOW,"      COST CENTER: ",IOINHI,$P(X1,"^",6)

 W !,IOINLOW,"     BOC: ",IOINHI,$E($P(X1,"^",8)_$E(SP,1,13),1,13),IOINLOW,$E(SP,1,7),"AMOUNT: ",IOINHI,$P(X1,"^",9)

 I $P(X1,"^",10)["$" W "   $"

 E  W !,IOINLOW,"     BOC: ",IOINHI,$E($P(X1,"^",10)_$E(SP,1,13),1,13),IOINLOW,$E(SP,1,7),"AMOUNT: ",IOINHI,$P(X1,"^",11)

 W IOINORM K IOINLOW,IOINHI,IOINORM,SP,X,X1 Q

71 ;DISPLAY 1358 USING 921.71 CODE SHEET

 D HILO^PRCFQ

 Q:'$D(^PRCF(423,DA))  S X=^PRCF(423,DA,0),X1=^(1)

 S $P(SP," ",80)=""

 W:$D(IOF) @IOF W !?5,IOINLOW,"OBLIGATION NUMBER: ",IOINHI,$P(X,"^",6),IOINLOW,$E(SP,1,10),"CODE SHEET #: ",IOINHI,PRCFA("CSNAME")

 W !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,$P(X,"^",4),IOINLOW,"    TRANSACTION DATE: ",IOINHI,$P(X,"^",5),IOINLOW,"       REF #: ",IOINHI,$P(X,"^",6)

 W !?4,IOINLOW,"CONTROL POINT: ",IOINHI,$E($P(X1,"^",5)_"    ",1,4),IOINLOW,"      COST CENTER: ",IOINHI,$P(X1,"^",6),$E(SP,1,9),IOINLOW,"SOURCE CODE: ",IOINHI,$P(X1,"^",3)

 W !,IOINLOW,?15,"SSN: ",IOINHI,$P(X1,"^",17),?50,IOINLOW,"STUB: ",IOINHI,$P(X1,"^",18),!

 F I=0:0 S I=$O(^PRCF(423,DA,13,I)) Q:'I  Q:'$D(^(I,0))  S X=^(0) W !,IOINLOW,"     BOC "_I_": ",IOINHI,$E($P(X,"^",6)_$E(SP,1,13),1,13),IOINLOW,$E(SP,1,7),"AMOUNT "_I_": ",IOINHI,$P(X,"^",9)

 K SP W IOINORM K IOINLOW,IOINHI,IOINORM,X,X1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFA921   2253     printed  Feb 18, 2025@23:28:07                                                                                                                                                                                                    Page 2

PRCFA921  ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY 921.00 OBLIGATION TRANSACTION ;8/26/93  1:27 PM

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

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

 +2        DO HILO^PRCFQ

DJ        ;RESERVED FOR CODE TO CALL A SCREEN HANDLER

LOAD       if '$DATA(^PRCF(423,DA))

               QUIT 

           SET X=^PRCF(423,DA,0)

           SET X1=^(1)

SE         SET $PIECE(SP," ",80)=""

 +1        if $DATA(IOF)

               WRITE @IOF

           WRITE !,IOINLOW,$EXTRACT(SP,1,5),"OBLIGATION NUMBER: ",IOINHI,$PIECE(X,"^",6),IOINLOW,$EXTRACT(SP,1,10),"CODE SHEET #: ",IOINHI,PRCFA("CSNAME")

 +2        WRITE !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,$PIECE(X,"^",4),IOINLOW,"    TRANSACTION DATE: ",IOINHI,$PIECE(X,"^",5),IOINLOW,"       REF #: ",IOINHI,$PIECE(X,"^",6)

 +3        WRITE !,IOINLOW," YALD CODE: ",IOINHI,$EXTRACT($PIECE(X1,"^")_"     ",1,6),IOINLOW,$EXTRACT(SP,1,6),"DEL MONTH: ",IOINHI

 +4        WRITE $SELECT(PRCFA("EDIT")'["921.60":$PIECE(X1,"^",2),1:$PIECE(X,"^",9)),IOINLOW,$EXTRACT(SP,1,6),"S/C: ",IOINHI,$PIECE(X1,"^",3),IOINLOW,$EXTRACT(SP,1,6),"DEL DATE: ",IOINHI,$PIECE(X1,"^",4)

 +5        WRITE !,$EXTRACT(SP,1,4),IOINLOW,"CONTROL POINT: ",IOINHI,$EXTRACT($PIECE(X1,"^",5)_"    ",1,4),IOINLOW,"      COST CENTER: ",IOINHI,$PIECE(X1,"^",6)

 +6        WRITE !,IOINLOW,"     BOC: ",IOINHI,$EXTRACT($PIECE(X1,"^",8)_$EXTRACT(SP,1,13),1,13),IOINLOW,$EXTRACT(SP,1,7),"AMOUNT: ",IOINHI,$PIECE(X1,"^",9)

 +7        IF $PIECE(X1,"^",10)["$"

               WRITE "   $"

 +8       IF '$TEST

               WRITE !,IOINLOW,"     BOC: ",IOINHI,$EXTRACT($PIECE(X1,"^",10)_$EXTRACT(SP,1,13),1,13),IOINLOW,$EXTRACT(SP,1,7),"AMOUNT: ",IOINHI,$PIECE(X1,"^",11)

 +9        WRITE IOINORM

           KILL IOINLOW,IOINHI,IOINORM,SP,X,X1

           QUIT 

71        ;DISPLAY 1358 USING 921.71 CODE SHEET

 +1        DO HILO^PRCFQ

 +2        if '$DATA(^PRCF(423,DA))

               QUIT 

           SET X=^PRCF(423,DA,0)

           SET X1=^(1)

 +3        SET $PIECE(SP," ",80)=""

 +4        if $DATA(IOF)

               WRITE @IOF

           WRITE !?5,IOINLOW,"OBLIGATION NUMBER: ",IOINHI,$PIECE(X,"^",6),IOINLOW,$EXTRACT(SP,1,10),"CODE SHEET #: ",IOINHI,PRCFA("CSNAME")

 +5        WRITE !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,$PIECE(X,"^",4),IOINLOW,"    TRANSACTION DATE: ",IOINHI,$PIECE(X,"^",5),IOINLOW,"       REF #: ",IOINHI,$PIECE(X,"^",6)

 +6        WRITE !?4,IOINLOW,"CONTROL POINT: ",IOINHI,$EXTRACT($PIECE(X1,"^",5)_"    ",1,4),IOINLOW,"      COST CENTER: ",IOINHI,$PIECE(X1,"^",6),$EXTRACT(SP,1,9),IOINLOW,"SOURCE CODE: ",IOINHI,$PIECE(X1,"^",3)

 +7        WRITE !,IOINLOW,?15,"SSN: ",IOINHI,$PIECE(X1,"^",17),?50,IOINLOW,"STUB: ",IOINHI,$PIECE(X1,"^",18),!

 +8        FOR I=0:0

               SET I=$ORDER(^PRCF(423,DA,13,I))

               if 'I

                   QUIT 

               if '$DATA(^(I,0))

                   QUIT 

               SET X=^(0)

               WRITE !,IOINLOW,"     BOC "_I_": ",IOINHI,$EXTRACT($PIECE(X,"^",6)_$EXTRACT(SP,1,13),1,13),IOINLOW,$EXTRACT(SP,1,7),"AMOUNT "_I_": ",IOINHI,$PIECE(X,"^",9)

 +9        KILL SP

           WRITE IOINORM

           KILL IOINLOW,IOINHI,IOINORM,X,X1