PRPFDMT ;ALTOONA/CTB DISPLAY MASTER TRANSACTION ;11/22/96 4:36 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
S DIC("A")="Select MASTER TRANSACTION ID: "
A D HILO^PRPFBAL S DIC=470.1,DIC(0)="AEMNZ" D ^DIC K DIC
I Y>0 S MADA(0)=Y(0),MADA=+Y S ZTRTN="INFO^PRPFDMT",(ZTSAVE("MADA*"),ZTSAVE("MADA"))="",ZTDESC="PATIENT FUNDS MASTER TRANSACTION DISPLAY" D ^PRPFQ S DIC("A")="Select Another MASTER TRANSACTION ID: " G A
K %,%H,C,DIC,I,K,MADA,PFHI,PFLO,PFNORM,POP,S,TMP,X,X2,Y W @IOF Q
INFO I $D(ZTSK) S (PFHI,PFLO,PFNORM)="*0" K ^%ZTSK(ZTSK)
W:$Y>1 @IOF W @PFHI,"Review Individual Master Transaction ",@PFLO,!
W !,@PFLO,"Transaction ID: ",@PFHI,$P(MADA(0),"^"),?40 S DFN=$P(MADA(0),"^",2) W @PFLO,"Patient Name: ",@PFHI,$S($D(^DPT(DFN,0)):$P(^(0),"^"),1:"UNKNOWN"),@PFLO,!?40,"Patient Transaction : ",@PFHI,$P(MADA(0),"^",3)
W !,@PFLO,"Transaction Date: " S Y=$P(MADA(0),"^",5) D D^PRPFU1 W @PFHI,Y
W ?40,@PFLO,"Date Entered: " S Y=$P(MADA(0),"^",6) D D^PRPFU1 W @PFHI,Y
W !,@PFLO,"Reference: ",@PFHI,$P(MADA(0),"^",7),?40,@PFLO,"Dep/With: ",@PFHI S DD=470.1,F=7,X=$P(MADA(0),"^",8) D ^PRPFU1 W Y
W @PFLO,!,"Source: " S X=$P(MADA(0),"^",10),X=$S(X="G":"GRATUITUOUS",X="P":"PRIVATE SOURCE",1:"BOTH") W @PFHI,X,@PFLO,?40,"Form: " S DD=470.1,F=10,X=$P(MADA(0),"^",11) D ^PRPFU1 W @PFHI,Y
W !,@PFLO,"Amount: ",@PFHI S Y=$P(MADA(0),"^",4),Y=$S($P(MADA(0),"^",8)["W":-Y,1:Y) W "$ ",$J(Y,0,2),?40,@PFLO,"CA/CK/OTH: " S X=$P(MADA(0),"^",9),X=$S(X=1:"CASH",X=2:"CHECK",1:"OTHER") W @PFHI,X
W !,@PFLO,"Private Source: " S Y=$P(MADA(0),"^",12),Y=$S($P(MADA(0),"^",8)["W":-Y,1:Y) W @PFHI,"$ ",$J(Y,0,2),@PFLO,?40,"Gratuitous: " S Y=$P(MADA(0),"^",13),Y=$S($P(MADA(0),"^",8)="W":-Y,1:Y) W @PFHI,"$ ",$J(Y,0,2)
W !,@PFLO,"Clerk: ",@PFHI S X=$P(MADA(0),"^",14),F=13,DD=470.1 D ^PRPFU1 W Y,?40,@PFLO,"Remarks: ",@PFHI,$P(MADA(0),"^",16),!,@PFLO,"Deferral Date: " S Y=$P(MADA(0),"^",21) D D^PRPFU1 W @PFHI,Y,@PFNORM
I '$D(ZTSK),$D(IOST)#2,IOST["C-" W !!,"Enter RETURN to Continue" R X:$S($D(DTIME):DTIME,1:120) W !!
K %,DFN,MADA,MADA(0),PFHI,PFLO,PFNORM,POP,PRIOP,X,Y,ZTDESC,ZTRTN,ZTSAVE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDMT 2098 printed Nov 22, 2024@17:11:38 Page 2
PRPFDMT ;ALTOONA/CTB DISPLAY MASTER TRANSACTION ;11/22/96 4:36 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
+1 SET DIC("A")="Select MASTER TRANSACTION ID: "
A DO HILO^PRPFBAL
SET DIC=470.1
SET DIC(0)="AEMNZ"
DO ^DIC
KILL DIC
+1 IF Y>0
SET MADA(0)=Y(0)
SET MADA=+Y
SET ZTRTN="INFO^PRPFDMT"
SET (ZTSAVE("MADA*"),ZTSAVE("MADA"))=""
SET ZTDESC="PATIENT FUNDS MASTER TRANSACTION DISPLAY"
DO ^PRPFQ
SET DIC("A")="Select Another MASTER TRANSACTION ID: "
GOTO A
+2 KILL %,%H,C,DIC,I,K,MADA,PFHI,PFLO,PFNORM,POP,S,TMP,X,X2,Y
WRITE @IOF
QUIT
INFO IF $DATA(ZTSK)
SET (PFHI,PFLO,PFNORM)="*0"
KILL ^%ZTSK(ZTSK)
+1 if $Y>1
WRITE @IOF
WRITE @PFHI,"Review Individual Master Transaction ",@PFLO,!
+2 WRITE !,@PFLO,"Transaction ID: ",@PFHI,$PIECE(MADA(0),"^"),?40
SET DFN=$PIECE(MADA(0),"^",2)
WRITE @PFLO,"Patient Name: ",@PFHI,$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),"^"),1:"UNKNOWN"),@PFLO,!?40,"Patient Transaction : ",@PFHI,$PIECE(MADA(0),"^",3)
+3 WRITE !,@PFLO,"Transaction Date: "
SET Y=$PIECE(MADA(0),"^",5)
DO D^PRPFU1
WRITE @PFHI,Y
+4 WRITE ?40,@PFLO,"Date Entered: "
SET Y=$PIECE(MADA(0),"^",6)
DO D^PRPFU1
WRITE @PFHI,Y
+5 WRITE !,@PFLO,"Reference: ",@PFHI,$PIECE(MADA(0),"^",7),?40,@PFLO,"Dep/With: ",@PFHI
SET DD=470.1
SET F=7
SET X=$PIECE(MADA(0),"^",8)
DO ^PRPFU1
WRITE Y
+6 WRITE @PFLO,!,"Source: "
SET X=$PIECE(MADA(0),"^",10)
SET X=$SELECT(X="G":"GRATUITUOUS",X="P":"PRIVATE SOURCE",1:"BOTH")
WRITE @PFHI,X,@PFLO,?40,"Form: "
SET DD=470.1
SET F=10
SET X=$PIECE(MADA(0),"^",11)
DO ^PRPFU1
WRITE @PFHI,Y
+7 WRITE !,@PFLO,"Amount: ",@PFHI
SET Y=$PIECE(MADA(0),"^",4)
SET Y=$SELECT($PIECE(MADA(0),"^",8)["W":-Y,1:Y)
WRITE "$ ",$JUSTIFY(Y,0,2),?40,@PFLO,"CA/CK/OTH: "
SET X=$PIECE(MADA(0),"^",9)
SET X=$SELECT(X=1:"CASH",X=2:"CHECK",1:"OTHER")
WRITE @PFHI,X
+8 WRITE !,@PFLO,"Private Source: "
SET Y=$PIECE(MADA(0),"^",12)
SET Y=$SELECT($PIECE(MADA(0),"^",8)["W":-Y,1:Y)
WRITE @PFHI,"$ ",$JUSTIFY(Y,0,2),@PFLO,?40,"Gratuitous: "
SET Y=$PIECE(MADA(0),"^",13)
SET Y=$SELECT($PIECE(MADA(0),"^",8)="W":-Y,1:Y)
WRITE @PFHI,"$ ",$JUSTIFY(Y,0,2)
+9 WRITE !,@PFLO,"Clerk: ",@PFHI
SET X=$PIECE(MADA(0),"^",14)
SET F=13
SET DD=470.1
DO ^PRPFU1
WRITE Y,?40,@PFLO,"Remarks: ",@PFHI,$PIECE(MADA(0),"^",16),!,@PFLO,"Deferral Date: "
SET Y=$PIECE(MADA(0),"^",21)
DO D^PRPFU1
WRITE @PFHI,Y,@PFNORM
+10 IF '$DATA(ZTSK)
IF $DATA(IOST)#2
IF IOST["C-"
WRITE !!,"Enter RETURN to Continue"
READ X:$SELECT($DATA(DTIME):DTIME,1:120)
WRITE !!
+11 KILL %,DFN,MADA,MADA(0),PFHI,PFLO,PFNORM,POP,PRIOP,X,Y,ZTDESC,ZTRTN,ZTSAVE
QUIT
