ABPACLG3 ;CHECK LOG UTILITY FUNCTIONS - PART 3; [ 06/26/91 7:26 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
Q ;;NOT AN ENTRY POINT
START ;ENTRY POINT
;---------------------------------------------------------------------
RETURN ;PROCEDURE TO PROCESS RETURNED CHECKS
I ABPA("FUNC")="R" D G GETCHK^ABPACLG1
.S DIR(0)="Y",DIR("A")=Y(0)_" NUMBER >>> "_ABPACHK("NUM")
.S DIR("A")=DIR("A")_" <<< ARE YOU SURE"
.D HEAD^ABPACLG1 S DX=0,DY=12
.X XY D EOP^ABPAMAIN W *7 D ^DIR K DIR I 'Y D Q
..D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
.W ! D WAIT^DICD K DIC,DIE,DR,DA
.S DA(2)=ABPADFN(1),DA(1)=ABPADFN(2),DA=ABPADFN(3)
.S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
.S DR="4///"_DUZ_";5///NOW;6///"_ABPA("FUNC")_";8///0"
.D ^DIE K ^ABPACHKS("RB",ABPADFN(1),ABPADFN(2),ABPADFN(3))
.I $D(^ABPACHKS(DA(2),"I",DA(1),"C",DA,"SP",0))'=1 D
..S ^ABPACHKS(DA(2),"I",DA(1),"C",DA,"SP",0)="^9002270.31113DA^^0"
.S %DT="T",X="NOW" D ^%DT K DIC,DIE,DR
.S DIC="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","_DA_",""SP"","
.K DA S DA(3)=ABPADFN(1),DA(2)=ABPADFN(2),DA(1)=ABPADFN(3)
.S DIC(0)="LZ",X=Y D ^DIC S ABPADFN(4)=+Y K DIC,DIE,DA,DR
.S DA(3)=ABPADFN(1),DA(2)=ABPADFN(2),DA(1)=ABPADFN(3),DA=ABPADFN(4)
.S DIE="^ABPACHKS("_DA(3)_",""I"","_DA(2)_",""C"","_DA(1)_",""SP"","
.S DR="1///"_ABPA("FUNC")_";2///"_DUZ_";3///"_ABPACHK("AMT")_";4"
.W ! D ^DIE I ABPADFN(1)=1 D
..S ABPA("$P")=+$P(^ABPAPBAT($P(ABPACHK("XMIT"),"."),0),"^",12)
..S ABPA("$P")=ABPA("$P")+ABPACHK("AMT")
..S $P(^ABPAPBAT($P(ABPACHK("XMIT"),"."),0),"^",12)=ABPA("$P")
.D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
;--------------------------------------------------------------------
TRANSFER ;PROCEDURE TO PROCESS CHECK TRANSFERS
D HEAD^ABPACLG1 S DX=0,DY=12 X XY D EOP^ABPAMAIN W !,ABPA("FD")
S MAX=ABPACHK("RAMT")
S DIR(0)="NO^:"_MAX_":2",DIR("A")=" HOW MUCH"
S DX=0,DY=14 X XY D EOP^ABPAMAIN D ^DIR K DIR S ABPA("AMT")=+Y
I +ABPA("AMT")'>0 D G GETCHK^ABPACLG1
.D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
S ABPA("TYPE")=2 I ABPA("AMT")=ABPACHK("AMT") S ABPA("TYPE")=1
D HEAD^ABPACLG1 S DX=0,DY=12 X XY D EOP^ABPAMAIN W !,ABPA("FD")
W " in the amount of $",$J(ABPA("AMT"),9,2),!
K DIR,DIC,DIE,DA,DR
S DIR(0)="PO^DIC(4,:EQZ",DIR("A")=" TO"
S DIR("A",1)=" FROM: "_$P(^DIC(4,ACTPTR,0),"^") D ^DIR K DIR
I 'Y D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1 G GETCHK^ABPACLG1
S ABPA("TO")=+Y I ACTPTR=ABPA("TO") D G GETCHK^ABPACLG1
.W *7,!?5,"<<< CANNOT TRANSFER TO THE SAME FACILITY >>>" H 3
.D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
D HEAD^ABPACLG1 S DX=0,DY=12 X XY D EOP^ABPAMAIN
W !?30,"Transfer Summary",!
W !?3,"$",$J(ABPA("AMT"),9,2)," of check #",ABPACHK("NUM")
W " from ",ABPAINS,!?3,"is to be transferred to "
W $P(^DIC(4,ABPA("TO"),0),"^")
S DIR(0)="Y",DIR("A")="Is this correct" W ! D ^DIR K DIR
I 'Y D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1 G GETCHK^ABPACLG1
G START^ABPACLG5
ABPACLG3 ;CHECK LOG UTILITY FUNCTIONS - PART 3; [ 06/26/91 7:26 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
START ;ENTRY POINT
+1 ;---------------------------------------------------------------------
RETURN ;PROCEDURE TO PROCESS RETURNED CHECKS
+1 IF ABPA("FUNC")="R"
Begin DoDot:1
+2 SET DIR(0)="Y"
SET DIR("A")=Y(0)_" NUMBER >>> "_ABPACHK("NUM")
+3 SET DIR("A")=DIR("A")_" <<< ARE YOU SURE"
+4 DO HEAD^ABPACLG1
SET DX=0
SET DY=12
+5 XECUTE XY
DO EOP^ABPAMAIN
WRITE *7
DO ^DIR
KILL DIR
IF 'Y
Begin DoDot:2
+6 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
End DoDot:2
QUIT
+7 WRITE !
DO WAIT^DICD
KILL DIC,DIE,DR,DA
+8 SET DA(2)=ABPADFN(1)
SET DA(1)=ABPADFN(2)
SET DA=ABPADFN(3)
+9 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
+10 SET DR="4///"_DUZ_";5///NOW;6///"_ABPA("FUNC")_";8///0"
+11 DO ^DIE
KILL ^ABPACHKS("RB",ABPADFN(1),ABPADFN(2),ABPADFN(3))
+12 IF $DATA(^ABPACHKS(DA(2),"I",DA(1),"C",DA,"SP",0))'=1
Begin DoDot:2
+13 SET ^ABPACHKS(DA(2),"I",DA(1),"C",DA,"SP",0)="^9002270.31113DA^^0"
End DoDot:2
+14 SET %DT="T"
SET X="NOW"
DO ^%DT
KILL DIC,DIE,DR
+15 SET DIC="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","_DA_",""SP"","
+16 KILL DA
SET DA(3)=ABPADFN(1)
SET DA(2)=ABPADFN(2)
SET DA(1)=ABPADFN(3)
+17 SET DIC(0)="LZ"
SET X=Y
DO ^DIC
SET ABPADFN(4)=+Y
KILL DIC,DIE,DA,DR
+18 SET DA(3)=ABPADFN(1)
SET DA(2)=ABPADFN(2)
SET DA(1)=ABPADFN(3)
SET DA=ABPADFN(4)
+19 SET DIE="^ABPACHKS("_DA(3)_",""I"","_DA(2)_",""C"","_DA(1)_",""SP"","
+20 SET DR="1///"_ABPA("FUNC")_";2///"_DUZ_";3///"_ABPACHK("AMT")_";4"
+21 WRITE !
DO ^DIE
IF ABPADFN(1)=1
Begin DoDot:2
+22 SET ABPA("$P")=+$PIECE(^ABPAPBAT($PIECE(ABPACHK("XMIT"),"."),0),"^",12)
+23 SET ABPA("$P")=ABPA("$P")+ABPACHK("AMT")
+24 SET $PIECE(^ABPAPBAT($PIECE(ABPACHK("XMIT"),"."),0),"^",12)=ABPA("$P")
End DoDot:2
+25 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
End DoDot:1
GOTO GETCHK^ABPACLG1
+26 ;--------------------------------------------------------------------
TRANSFER ;PROCEDURE TO PROCESS CHECK TRANSFERS
+1 DO HEAD^ABPACLG1
SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
WRITE !,ABPA("FD")
+2 SET MAX=ABPACHK("RAMT")
+3 SET DIR(0)="NO^:"_MAX_":2"
SET DIR("A")=" HOW MUCH"
+4 SET DX=0
SET DY=14
XECUTE XY
DO EOP^ABPAMAIN
DO ^DIR
KILL DIR
SET ABPA("AMT")=+Y
+5 IF +ABPA("AMT")'>0
Begin DoDot:1
+6 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
End DoDot:1
GOTO GETCHK^ABPACLG1
+7 SET ABPA("TYPE")=2
IF ABPA("AMT")=ABPACHK("AMT")
SET ABPA("TYPE")=1
+8 DO HEAD^ABPACLG1
SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
WRITE !,ABPA("FD")
+9 WRITE " in the amount of $",$JUSTIFY(ABPA("AMT"),9,2),!
+10 KILL DIR,DIC,DIE,DA,DR
+11 SET DIR(0)="PO^DIC(4,:EQZ"
SET DIR("A")=" TO"
+12 SET DIR("A",1)=" FROM: "_$PIECE(^DIC(4,ACTPTR,0),"^")
DO ^DIR
KILL DIR
+13 IF 'Y
DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
GOTO GETCHK^ABPACLG1
+14 SET ABPA("TO")=+Y
IF ACTPTR=ABPA("TO")
Begin DoDot:1
+15 WRITE *7,!?5,"<<< CANNOT TRANSFER TO THE SAME FACILITY >>>"
HANG 3
+16 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
End DoDot:1
GOTO GETCHK^ABPACLG1
+17 DO HEAD^ABPACLG1
SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
+18 WRITE !?30,"Transfer Summary",!
+19 WRITE !?3,"$",$JUSTIFY(ABPA("AMT"),9,2)," of check #",ABPACHK("NUM")
+20 WRITE " from ",ABPAINS,!?3,"is to be transferred to "
+21 WRITE $PIECE(^DIC(4,ABPA("TO"),0),"^")
+22 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
WRITE !
DO ^DIR
KILL DIR
+23 IF 'Y
DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
GOTO GETCHK^ABPACLG1
+24 GOTO START^ABPACLG5
