- 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
