ABPACKLK ;LOOK UP UNPROCESSED CHECKS; [ 08/17/91 1:29 PM ]
;;1.4;AO PVT-INS TRACKING;*1*;IHS-OKC/KJR;AUG 17, 1991
;;PATCH #1: INIT+3 MODIFIED TO SCREEN FOR 'N';IHS-OKC/KJR;17AUG91
W !!,"<<< NOT AN ACCESS POINT - ACCESS DENIED >>>",!!,Q
;--------------------------------------------------------------------
CLEAR ;PROCEDURE TO KILL TEMPORARY LOCAL VARIABLES
K DIR,R,RR,J,K,CNT,M,IPTR,TEMP,RRR,INSNAME,L,ACCTPT,ACTPTR,AP
Q
;--------------------------------------------------------------------
INIT ;PROCEDURE TO INITIALIZE TEMPORARY LOCAL VARIABLES
S GOTCHECK=0 S:$D(RESTRICT)'=1 RESTRICT=1
S:$D(ABPA("LOG"))'=1 ABPA("LOG")=0
S:$D(ABPASCR)'=1 ABPASCR="I $P(^ABPACHKS(AP,""I"",RR,""C"",RRR,0),""^"",9)'>0!($P(^ABPACHKS(AP,""I"",RR,""C"",RRR,0),""^"",12)=""N"") S QFLG="""""
Q
;--------------------------------------------------------------------
GETCHK ;PROCEDURE TO GET CHECK NUMBER TO LOOK UP
K DIR,ABPACHK S DIR(0)="FO",DIR("A")="Select CHECK NUMBER" D ^DIR
S ABPACHK=Y
Q
;--------------------------------------------------------------------
LOOK ;PROCEDURE TO LOOK-UP AND DISPLAY CHECK DATA
D INIT Q:$D(^ABPACHKS("AB",ABPACHK))'=10
S CNT=0,R=ABPACHK,AP=0 F M=0:0 D Q:+AP=0
.S AP=$O(^ABPACHKS("AB",R,AP)) Q:+AP=0
.S RR=0 F K=0:0 D Q:+RR=0
..S RR=$O(^ABPACHKS("AB",R,AP,RR)) Q:+RR=0
..S RRR=0 F L=0:0 D Q:+RRR=0
...S RRR=$O(^ABPACHKS("AB",R,AP,RR,RRR)) Q:+RRR=0
...Q:$D(^ABPACHKS(AP,"I",RR,"C",RRR,0))'=1
...I RESTRICT K QFLG X ABPASCR Q:$D(QFLG)=1
...S CNT=CNT+1,TEMP(CNT,AP,RR,RRR)=^ABPACHKS(AP,"I",RR,"C",RRR,0)
I +CNT>0 D
.W !!?3,"Acct",?10,"Check Number",?24,"Payor",?63,"Amount"
.W ?72,"Balance" F J=1:1:CNT D
..Q:$D(TEMP(J))'=10
..S AP=$O(TEMP(J,"")),ACCTPT="??"
..I $D(^ABPACHKS(AP,0))=1 S ACTPTR=+^(0) Q:+ACTPTR'>0
..I $D(^AUTTLOC(ACTPTR,0))=1 S ACCTPT=$P(^(0),"^",17)
..S RR=$O(TEMP(J,AP,"")),INSNAME="*** UNKNOWN ***"
..I $D(^ABPACHKS(AP,"I",RR,0))=1 S IPTR=+^(0) Q:+IPTR'>0
..I $D(^AUTNINS(IPTR,0))=1 S INSNAME=$E($P(^(0),"^"),1,35)
..S RRR=$O(TEMP(J,AP,RR,"")) Q:+RRR'>0
..W !,J,?3,ACCTPT,?7,$J($P(TEMP(J,AP,RR,RRR),"^"),15),?24,INSNAME
..W ?61,$J($P(TEMP(J,AP,RR,RRR),"^",4),8,2)
..W ?71,$J($P(TEMP(J,AP,RR,RRR),"^",9),8,2)
.I +CNT>1 F J=0:0 D Q:+Y>0!(Y']"")!(Y["^")
..K DIR S DIR(0)="NO^1:"_CNT,DIR("A")="CHOOSE" W ! D ^DIR
.I +CNT=1 F J=0:0 D Q:"01"[Y
..K DIR S DIR(0)="Y",DIR("A")="IS THIS THE CORRECT CHECK"
..S DIR("B")="YES" W ! D ^DIR
.Q:+Y'>0 Q:$D(TEMP(+Y))'=10
.K ABPACHK S AP=$O(TEMP(+Y,"")) Q:AP="" Q:$D(TEMP(+Y,AP))'=10
.S R=$O(TEMP(+Y,AP,"")) Q:+R'>0 Q:$D(TEMP(+Y,AP,R))'=10
.S RR=$O(TEMP(+Y,AP,R,"")) Q:+RR'>0 Q:$D(TEMP(+Y,AP,R,RR))'=1
.S ABPACHK(AP,R,RR)=TEMP(+Y,AP,R,RR),GOTCHECK=1
.S ABPACHK("NUM")=$P(ABPACHK(AP,R,RR),"^")
.S ABPACHK("AMT")=$P(ABPACHK(AP,R,RR),"^",4)
.S ABPACHK("RAMT")=$P(ABPACHK(AP,R,RR),"^",9)
.S ABPACHK("PAYOR")=$P(^AUTNINS(+^ABPACHKS(AP,"I",R,0),0),"^")
.S ABPACHK("XMIT")=$P(ABPACHK(AP,R,RR),"^",2)
.S ABPACHK("LUSR")=$P(ABPACHK(AP,R,RR),"^",10) I ABPACHK("LUSR")]"" D
..S ABPACHK("LUSR")=$P(^DIC(3,ABPACHK("LUSR"),0),"^",2)
..S ABPA("DTIN")=$P($P(ABPACHK(AP,R,RR),"^",11),".")
..D DTCVT^ABPAMAIN
..S ABPACHK("LUSR")=ABPACHK("LUSR")_" ON "_ABPA("DTOUT")
.S AP=$P(^ABPACHKS(AP,0),"^"),ABPACHK("AP")=$P(^AUTTLOC(AP,0),"^",4)
.S ABPACHK("APNAM")=$P(^DIC(4,AP,0),"^")
I ('GOTCHECK&('RESTRICT))!(ABPA("LOG")) Q
I 'GOTCHECK D I Y]"" I $E(Y,1)'=" " I Y'["^" G LOOK
.W *7," ??",! D GETCHK
Q
;--------------------------------------------------------------------
MAIN ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
D CLEAR,INIT,GETCHK I Y']""!(Y']" ")!(Y["^") D CLEAR Q
D LOOK,CLEAR K RESTRICT,ABPASCR
Q
ABPACKLK ;LOOK UP UNPROCESSED CHECKS; [ 08/17/91 1:29 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*1*;IHS-OKC/KJR;AUG 17, 1991
+2 ;;PATCH #1: INIT+3 MODIFIED TO SCREEN FOR 'N';IHS-OKC/KJR;17AUG91
+3 WRITE !!,"<<< NOT AN ACCESS POINT - ACCESS DENIED >>>",!!,Q
+4 ;--------------------------------------------------------------------
CLEAR ;PROCEDURE TO KILL TEMPORARY LOCAL VARIABLES
+1 KILL DIR,R,RR,J,K,CNT,M,IPTR,TEMP,RRR,INSNAME,L,ACCTPT,ACTPTR,AP
+2 QUIT
+3 ;--------------------------------------------------------------------
INIT ;PROCEDURE TO INITIALIZE TEMPORARY LOCAL VARIABLES
+1 SET GOTCHECK=0
IF $DATA(RESTRICT)'=1
SET RESTRICT=1
+2 IF $DATA(ABPA("LOG"))'=1
SET ABPA("LOG")=0
+3 IF $DATA(ABPASCR)'=1
SET ABPASCR="I $P(^ABPACHKS(AP,""I"",RR,""C"",RRR,0),""^"",9)'>0!($P(^ABPACHKS(AP,""I"",RR,""C"",RRR,0),""^"",12)=""N"") S QFLG="""""
+4 QUIT
+5 ;--------------------------------------------------------------------
GETCHK ;PROCEDURE TO GET CHECK NUMBER TO LOOK UP
+1 KILL DIR,ABPACHK
SET DIR(0)="FO"
SET DIR("A")="Select CHECK NUMBER"
DO ^DIR
+2 SET ABPACHK=Y
+3 QUIT
+4 ;--------------------------------------------------------------------
LOOK ;PROCEDURE TO LOOK-UP AND DISPLAY CHECK DATA
+1 DO INIT
IF $DATA(^ABPACHKS("AB",ABPACHK))'=10
QUIT
+2 SET CNT=0
SET R=ABPACHK
SET AP=0
FOR M=0:0
Begin DoDot:1
+3 SET AP=$ORDER(^ABPACHKS("AB",R,AP))
IF +AP=0
QUIT
+4 SET RR=0
FOR K=0:0
Begin DoDot:2
+5 SET RR=$ORDER(^ABPACHKS("AB",R,AP,RR))
IF +RR=0
QUIT
+6 SET RRR=0
FOR L=0:0
Begin DoDot:3
+7 SET RRR=$ORDER(^ABPACHKS("AB",R,AP,RR,RRR))
IF +RRR=0
QUIT
+8 IF $DATA(^ABPACHKS(AP,"I",RR,"C",RRR,0))'=1
QUIT
+9 IF RESTRICT
KILL QFLG
XECUTE ABPASCR
IF $DATA(QFLG)=1
QUIT
+10 SET CNT=CNT+1
SET TEMP(CNT,AP,RR,RRR)=^ABPACHKS(AP,"I",RR,"C",RRR,0)
End DoDot:3
IF +RRR=0
QUIT
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +AP=0
QUIT
+11 IF +CNT>0
Begin DoDot:1
+12 WRITE !!?3,"Acct",?10,"Check Number",?24,"Payor",?63,"Amount"
+13 WRITE ?72,"Balance"
FOR J=1:1:CNT
Begin DoDot:2
+14 IF $DATA(TEMP(J))'=10
QUIT
+15 SET AP=$ORDER(TEMP(J,""))
SET ACCTPT="??"
+16 IF $DATA(^ABPACHKS(AP,0))=1
SET ACTPTR=+^(0)
IF +ACTPTR'>0
QUIT
+17 IF $DATA(^AUTTLOC(ACTPTR,0))=1
SET ACCTPT=$PIECE(^(0),"^",17)
+18 SET RR=$ORDER(TEMP(J,AP,""))
SET INSNAME="*** UNKNOWN ***"
+19 IF $DATA(^ABPACHKS(AP,"I",RR,0))=1
SET IPTR=+^(0)
IF +IPTR'>0
QUIT
+20 IF $DATA(^AUTNINS(IPTR,0))=1
SET INSNAME=$EXTRACT($PIECE(^(0),"^"),1,35)
+21 SET RRR=$ORDER(TEMP(J,AP,RR,""))
IF +RRR'>0
QUIT
+22 WRITE !,J,?3,ACCTPT,?7,$JUSTIFY($PIECE(TEMP(J,AP,RR,RRR),"^"),15),?24,INSNAME
+23 WRITE ?61,$JUSTIFY($PIECE(TEMP(J,AP,RR,RRR),"^",4),8,2)
+24 WRITE ?71,$JUSTIFY($PIECE(TEMP(J,AP,RR,RRR),"^",9),8,2)
End DoDot:2
+25 IF +CNT>1
FOR J=0:0
Begin DoDot:2
+26 KILL DIR
SET DIR(0)="NO^1:"_CNT
SET DIR("A")="CHOOSE"
WRITE !
DO ^DIR
End DoDot:2
IF +Y>0!(Y']"")!(Y["^")
QUIT
+27 IF +CNT=1
FOR J=0:0
Begin DoDot:2
+28 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="IS THIS THE CORRECT CHECK"
+29 SET DIR("B")="YES"
WRITE !
DO ^DIR
End DoDot:2
IF "01"[Y
QUIT
+30 IF +Y'>0
QUIT
IF $DATA(TEMP(+Y))'=10
QUIT
+31 KILL ABPACHK
SET AP=$ORDER(TEMP(+Y,""))
IF AP=""
QUIT
IF $DATA(TEMP(+Y,AP))'=10
QUIT
+32 SET R=$ORDER(TEMP(+Y,AP,""))
IF +R'>0
QUIT
IF $DATA(TEMP(+Y,AP,R))'=10
QUIT
+33 SET RR=$ORDER(TEMP(+Y,AP,R,""))
IF +RR'>0
QUIT
IF $DATA(TEMP(+Y,AP,R,RR))'=1
QUIT
+34 SET ABPACHK(AP,R,RR)=TEMP(+Y,AP,R,RR)
SET GOTCHECK=1
+35 SET ABPACHK("NUM")=$PIECE(ABPACHK(AP,R,RR),"^")
+36 SET ABPACHK("AMT")=$PIECE(ABPACHK(AP,R,RR),"^",4)
+37 SET ABPACHK("RAMT")=$PIECE(ABPACHK(AP,R,RR),"^",9)
+38 SET ABPACHK("PAYOR")=$PIECE(^AUTNINS(+^ABPACHKS(AP,"I",R,0),0),"^")
+39 SET ABPACHK("XMIT")=$PIECE(ABPACHK(AP,R,RR),"^",2)
+40 SET ABPACHK("LUSR")=$PIECE(ABPACHK(AP,R,RR),"^",10)
IF ABPACHK("LUSR")]""
Begin DoDot:2
+41 SET ABPACHK("LUSR")=$PIECE(^DIC(3,ABPACHK("LUSR"),0),"^",2)
+42 SET ABPA("DTIN")=$PIECE($PIECE(ABPACHK(AP,R,RR),"^",11),".")
+43 DO DTCVT^ABPAMAIN
+44 SET ABPACHK("LUSR")=ABPACHK("LUSR")_" ON "_ABPA("DTOUT")
End DoDot:2
+45 SET AP=$PIECE(^ABPACHKS(AP,0),"^")
SET ABPACHK("AP")=$PIECE(^AUTTLOC(AP,0),"^",4)
+46 SET ABPACHK("APNAM")=$PIECE(^DIC(4,AP,0),"^")
End DoDot:1
+47 IF ('GOTCHECK&('RESTRICT))!(ABPA("LOG"))
QUIT
+48 IF 'GOTCHECK
Begin DoDot:1
+49 WRITE *7," ??",!
DO GETCHK
End DoDot:1
IF Y]""
IF $EXTRACT(Y,1)'=" "
IF Y'["^"
GOTO LOOK
+50 QUIT
+51 ;--------------------------------------------------------------------
MAIN ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
+1 DO CLEAR
DO INIT
DO GETCHK
IF Y']""!(Y']" ")!(Y["^")
DO CLEAR
QUIT
+2 DO LOOK
DO CLEAR
KILL RESTRICT,ABPASCR
+3 QUIT
