ABPACLG2 ;CHECK LOG UTILITY FUNCTIONS - PART 2; [ 06/27/91 7:38 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
Q ;;NOT AN ENTRY POINT
;---------------------------------------------------------------------
START ;PROCEDURE TO SELECT FUNCTION TO PERFORM
S DX=0,DY=12 X XY D EOP^ABPAMAIN W !,"Check Log FUNCTIONS"
K DIR,ABPA("FUNC")
S DIR(0)="SO^1:EDIT CHECK NUMBER;2:RETURN CHECK;3:TRANSFER CHECK"
S DIR(0)=DIR(0)_";4:FLAG AS IMPROPERLY LOGGED"
S DIR("A")="FUNCTION" D ^DIR K DIR
I +Y'>0!(+Y'<5) D G GETCHK^ABPACLG1
.D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
S ABPA("FUNC")=$S(Y=1:"E",Y=2:"R",Y=3:"T",Y=4:"I"),ABPA("FD")=Y(0)
I ABPA("FUNC")="E" D G GETCHK^ABPACLG1
.;------------------------------------------------------------------
.;PROCEDURE TO EDIT THE CHECK NUMBER
.D HEAD^ABPACLG1 S DX=0,DY=12 X XY D EOP^ABPAMAIN W !,ABPA("FD")
.K DIC,DIE,DIR,DA,DR
.S DA(2)=ABPADFN(1),DA(1)=ABPADFN(2),DA=ABPADFN(3)
.S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
.S DR=".01" W ! D ^DIE S ABPACHK("NNUM")=X
.S DR="4///"_DUZ_";5///NOW" D ^DIE
.I ABPACHK("NNUM")'=ABPACHK("NUM") D
..S ^TMP("ABPACLG1","E",ABPACHK("NUM"),ABPACHK("AMT"),INSPTR,ABPACHK("NNUM"),DT)=ABPACHK("XMIT")
.D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1
.;------------------------------------------------------------------
I "IR"[ABPA("FUNC") K QFLG D I $D(QFLG)=1 K QFLG G GETCHK^ABPACLG1
.I ABPACHK("AMT")'=ABPACHK("RAMT") D
..W *7,!?5,"<<< INVALID FUNCTION - CHECK PARTIALLY PROCESSED >>>"
..H 2 D CLEAR^ABPACLG1 K ABPACHK D HEAD^ABPACLG1 S QFLG=""
G:ABPA("FUNC")="I" START^ABPACLG7 G START^ABPACLG3
ABPACLG2 ;CHECK LOG UTILITY FUNCTIONS - PART 2; [ 06/27/91 7:38 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
+3 ;---------------------------------------------------------------------
START ;PROCEDURE TO SELECT FUNCTION TO PERFORM
+1 SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
WRITE !,"Check Log FUNCTIONS"
+2 KILL DIR,ABPA("FUNC")
+3 SET DIR(0)="SO^1:EDIT CHECK NUMBER;2:RETURN CHECK;3:TRANSFER CHECK"
+4 SET DIR(0)=DIR(0)_";4:FLAG AS IMPROPERLY LOGGED"
+5 SET DIR("A")="FUNCTION"
DO ^DIR
KILL DIR
+6 IF +Y'>0!(+Y'<5)
Begin DoDot:1
+7 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
End DoDot:1
GOTO GETCHK^ABPACLG1
+8 SET ABPA("FUNC")=$SELECT(Y=1:"E",Y=2:"R",Y=3:"T",Y=4:"I")
SET ABPA("FD")=Y(0)
+9 IF ABPA("FUNC")="E"
Begin DoDot:1
+10 ;------------------------------------------------------------------
+11 ;PROCEDURE TO EDIT THE CHECK NUMBER
+12 DO HEAD^ABPACLG1
SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
WRITE !,ABPA("FD")
+13 KILL DIC,DIE,DIR,DA,DR
+14 SET DA(2)=ABPADFN(1)
SET DA(1)=ABPADFN(2)
SET DA=ABPADFN(3)
+15 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
+16 SET DR=".01"
WRITE !
DO ^DIE
SET ABPACHK("NNUM")=X
+17 SET DR="4///"_DUZ_";5///NOW"
DO ^DIE
+18 IF ABPACHK("NNUM")'=ABPACHK("NUM")
Begin DoDot:2
+19 SET ^TMP("ABPACLG1","E",ABPACHK("NUM"),ABPACHK("AMT"),INSPTR,ABPACHK("NNUM"),DT)=ABPACHK("XMIT")
End DoDot:2
+20 DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
+21 ;------------------------------------------------------------------
End DoDot:1
GOTO GETCHK^ABPACLG1
+22 IF "IR"[ABPA("FUNC")
KILL QFLG
Begin DoDot:1
+23 IF ABPACHK("AMT")'=ABPACHK("RAMT")
Begin DoDot:2
+24 WRITE *7,!?5,"<<< INVALID FUNCTION - CHECK PARTIALLY PROCESSED >>>"
+25 HANG 2
DO CLEAR^ABPACLG1
KILL ABPACHK
DO HEAD^ABPACLG1
SET QFLG=""
End DoDot:2
End DoDot:1
IF $DATA(QFLG)=1
KILL QFLG
GOTO GETCHK^ABPACLG1
+26 IF ABPA("FUNC")="I"
GOTO START^ABPACLG7
GOTO START^ABPACLG3