ABPADC01 ;CONVERT PAYMENT DATA TO v1.4 FORMAT; [ 07/08/91 9:10 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!,"<<< NOT AN ENTRY POINT - JOB ABORTED >>>",!! Q
BEGIN ;ENTRY POINT
D SETUP H 2 D GETDATA,END
Q
SETUP ;
S ABPA("C%")=.02,ABPA("CONVERT")="" I $D(ABPAROFF)'=1 D CRT^ABPAVAR
S ABPA("PCNT")=$P(^ABPVAO(0),"^",4) Q:+ABPA("PCNT")'>0
F I=.02:.02:1 S ABPA(I,"%")=ABPA("PCNT")*I
W !!?3,"Converting your payment data to the v1.4 format:",!!?6,"You "
W "have ",ABPA("PCNT")," patient(s) in your database to process."
W !!?6,"Starting time: " S %H=$H D YX^%DTC W $P(Y,"@",2),!!
S X="Percentage of your database converted" W ?(40-($L(X)\2)),X,!
W ?13,0 F I=10:10:100 W ?($X+3) W:I=10 " " W I
W !?13,"|" F I=1:1:10 W "----|"
F I=$X:-1:14 W @IOBS W:I=14 @ABPARON
Q
GETDATA ;
S ABPA("RCT")=0,ABPATDFN=0 F D Q:+ABPATDFN=0
.S ABPATDFN=$O(^ABPVAO(ABPATDFN)) Q:+ABPATDFN=0
.S ABPA("RCT")=ABPA("RCT")+1,ABPADDFN=0 F D Q:+ABPADDFN=0
..S ABPADDFN=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN)) Q:+ABPADDFN=0
..D KVARS S (ABPACAMT,ABPACCNT,ABPAOBAL,ABPATPD)=0
..S (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7)=0
..F C="N","D","S" S ABPA("UP",C)=0
..S ABPAAPTR=0 F D Q:+ABPAAPTR=0
...S ABPAAPTR=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",ABPAAPTR))
...Q:+ABPAAPTR=0 S X=^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",ABPAAPTR,0)
...S ABPAPCOD=$P(X,"^",2) I ABPAPCOD]"" I "NDS"[ABPAPCOD D
....S ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+X)
..S ABPADPTR=0 F D Q:+ABPADPTR=0
...S ABPADPTR=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR))
...Q:+ABPADPTR=0
...S ABPADOS=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR,0)
...S DA=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR,0),"^",2)
...Q:$D(^ABPVAO(ABPATDFN,1,DA,0))'=1 D GETDAT
..D BEGIN^ABPAPD7A,CURARAY^ABPAPD7C S ABPA("Y")=3 D FILE^ABPAPD7
.I ABPA("RCT")'<ABPA(ABPA("C%"),"%") D UPDATE
Q
GETDAT ;
S ABPAPTR=+DA,ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
S ABPA("CP",ABPADOS,DA)="0^0^0^0^0^0"
S ABPA("HP",ABPADOS,DA)=ABPA("CP",ABPADOS,DA) D HPARRAY
S ABPACCNT=ABPACCNT+1,ABPA("C",ABPACCNT)=DA
S ABPACAMT=ABPACAMT+$P(ABPADATA,"^",7)
F J=2,3,4,5,7 D
.S @("ABPATA"_J)=@("ABPATA"_J)+$P(ABPA("HP",ABPADOS,DA),"^",J)
Q
HPARRAY ;
F ABPAJ=2:1:5 S @("ABPAP"_ABPAJ)=0
S ABPAZ=0 F S ABPAPTOT=0 D Q:+ABPAZ=0
.S ABPAZ=$O(^ABPVAO("PD",ABPATDFN,DA,ABPAZ)) Q:+ABPAZ=0
.S ABPAZZ=0 F D Q:+ABPAZZ=0
..S ABPAZZ=$O(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ)) Q:+ABPAZZ=0
..Q:$D(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ,0))'=1 S ABPARCD=^(0)
..Q:$P(ABPARCD,"^",2)'=DA F ABPAL=3:1:6 D
...S @("ABPAP"_(ABPAL-1))=@("ABPAP"_(ABPAL-1))+$P(ABPARCD,"^",ABPAL)
S ABPAPTOT=ABPAP2+ABPAP3+ABPAP4+ABPAP5,ABPATPD=ABPATPD+ABPAPTOT
S ABPABAL=($P(ABPADATA,"^",7)-ABPAPTOT)-(+$P(ABPADATA,"^",3))
S $P(ABPA("HP",ABPADOS,DA),"^")=ABPABAL,ABPAOBAL=ABPAOBAL+ABPABAL
F ABPAJ=2:1:5 S $P(ABPA("HP",ABPADOS,DA),"^",ABPAJ)=@("ABPAP"_ABPAJ)
S $P(ABPA("HP",ABPADOS,DA),"^",6)=ABPAPTOT
S $P(ABPA("HP",ABPADOS,DA),"^",7)=+$P(ABPADATA,"^",3)
Q
UPDATE ;
I ABPA("C%")#.1'=0 W:ABPA("C%")=.02 "|" W "-"
E W "|"
S ABPA("C%")=ABPA("C%")+.02
Q
END ;
F Q:ABPA("C%")>1 D UPDATE
W @ABPAROFF,!!?6,"Ending time: " S %H=$H D YX^%DTC W $P(Y,"@",2),!!
K ABPATDFN,ABPADDFN,ABPA
KVARS ;
K ABPACAMT,ABPACCNT,ABPA("HP"),ABPA("CP"),ABPA("PP"),ABPA("UP")
K ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAP6,ABPAPTOT,ABPACDFN,ABPAY
K ABPA("PB"),ABPA("NB"),ABPA("DB"),ABPA("SB"),ABPACTOB,ABPADOS
K ABPACURB,ABPA("S$"),ABPA("N$"),ABPA("P$"),ABPA("D$"),ABPATCNT
K ABPATBAL,ABPA("%"),ABPA("$"),ABPAD,ABPADATA,ABPAY,ABPAZ,ABPAZZ
K ABPAT1,ABPAT2,ABPAT3,ABPAT4,ABPAT5,ABPAT6,ABPAH2,ABPAH3,ABPAH4
K ABPAH5,ABPACURA,ABPAAPTR,X,ABPAPCOD,ABPADPTR,DA,ABPAPTR
Q
ABPADC01 ;CONVERT PAYMENT DATA TO v1.4 FORMAT; [ 07/08/91 9:10 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!,"<<< NOT AN ENTRY POINT - JOB ABORTED >>>",!!
QUIT
BEGIN ;ENTRY POINT
+1 DO SETUP
HANG 2
DO GETDATA
DO END
+2 QUIT
SETUP ;
+1 SET ABPA("C%")=.02
SET ABPA("CONVERT")=""
IF $DATA(ABPAROFF)'=1
DO CRT^ABPAVAR
+2 SET ABPA("PCNT")=$PIECE(^ABPVAO(0),"^",4)
IF +ABPA("PCNT")'>0
QUIT
+3 FOR I=.02:.02:1
SET ABPA(I,"%")=ABPA("PCNT")*I
+4 WRITE !!?3,"Converting your payment data to the v1.4 format:",!!?6,"You "
+5 WRITE "have ",ABPA("PCNT")," patient(s) in your database to process."
+6 WRITE !!?6,"Starting time: "
SET %H=$HOROLOG
DO YX^%DTC
WRITE $PIECE(Y,"@",2),!!
+7 SET X="Percentage of your database converted"
WRITE ?(40-($LENGTH(X)\2)),X,!
+8 WRITE ?13,0
FOR I=10:10:100
WRITE ?($X+3)
IF I=10
WRITE " "
WRITE I
+9 WRITE !?13,"|"
FOR I=1:1:10
WRITE "----|"
+10 FOR I=$X:-1:14
WRITE @IOBS
IF I=14
WRITE @ABPARON
+11 QUIT
GETDATA ;
+1 SET ABPA("RCT")=0
SET ABPATDFN=0
FOR
Begin DoDot:1
+2 SET ABPATDFN=$ORDER(^ABPVAO(ABPATDFN))
IF +ABPATDFN=0
QUIT
+3 SET ABPA("RCT")=ABPA("RCT")+1
SET ABPADDFN=0
FOR
Begin DoDot:2
+4 SET ABPADDFN=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN))
IF +ABPADDFN=0
QUIT
+5 DO KVARS
SET (ABPACAMT,ABPACCNT,ABPAOBAL,ABPATPD)=0
+6 SET (ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7)=0
+7 FOR C="N","D","S"
SET ABPA("UP",C)=0
+8 SET ABPAAPTR=0
FOR
Begin DoDot:3
+9 SET ABPAAPTR=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",ABPAAPTR))
+10 IF +ABPAAPTR=0
QUIT
SET X=^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",ABPAAPTR,0)
+11 SET ABPAPCOD=$PIECE(X,"^",2)
IF ABPAPCOD]""
IF "NDS"[ABPAPCOD
Begin DoDot:4
+12 SET ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+X)
End DoDot:4
End DoDot:3
IF +ABPAAPTR=0
QUIT
+13 SET ABPADPTR=0
FOR
Begin DoDot:3
+14 SET ABPADPTR=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR))
+15 IF +ABPADPTR=0
QUIT
+16 SET ABPADOS=+^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR,0)
+17 SET DA=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADPTR,0),"^",2)
+18 IF $DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1
QUIT
DO GETDAT
End DoDot:3
IF +ABPADPTR=0
QUIT
+19 DO BEGIN^ABPAPD7A
DO CURARAY^ABPAPD7C
SET ABPA("Y")=3
DO FILE^ABPAPD7
End DoDot:2
IF +ABPADDFN=0
QUIT
+20 IF ABPA("RCT")'<ABPA(ABPA("C%"),"%")
DO UPDATE
End DoDot:1
IF +ABPATDFN=0
QUIT
+21 QUIT
GETDAT ;
+1 SET ABPAPTR=+DA
SET ABPADATA=^ABPVAO(ABPATDFN,1,ABPAPTR,0)
+2 SET ABPA("CP",ABPADOS,DA)="0^0^0^0^0^0"
+3 SET ABPA("HP",ABPADOS,DA)=ABPA("CP",ABPADOS,DA)
DO HPARRAY
+4 SET ABPACCNT=ABPACCNT+1
SET ABPA("C",ABPACCNT)=DA
+5 SET ABPACAMT=ABPACAMT+$PIECE(ABPADATA,"^",7)
+6 FOR J=2,3,4,5,7
Begin DoDot:1
+7 SET @("ABPATA"_J)=@("ABPATA"_J)+$PIECE(ABPA("HP",ABPADOS,DA),"^",J)
End DoDot:1
+8 QUIT
HPARRAY ;
+1 FOR ABPAJ=2:1:5
SET @("ABPAP"_ABPAJ)=0
+2 SET ABPAZ=0
FOR
SET ABPAPTOT=0
Begin DoDot:1
+3 SET ABPAZ=$ORDER(^ABPVAO("PD",ABPATDFN,DA,ABPAZ))
IF +ABPAZ=0
QUIT
+4 SET ABPAZZ=0
FOR
Begin DoDot:2
+5 SET ABPAZZ=$ORDER(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ))
IF +ABPAZZ=0
QUIT
+6 IF $DATA(^ABPVAO(ABPATDFN,"P",ABPAZ,"D",ABPAZZ,0))'=1
QUIT
SET ABPARCD=^(0)
+7 IF $PIECE(ABPARCD,"^",2)'=DA
QUIT
FOR ABPAL=3:1:6
Begin DoDot:3
+8 SET @("ABPAP"_(ABPAL-1))=@("ABPAP"_(ABPAL-1))+$PIECE(ABPARCD,"^",ABPAL)
End DoDot:3
End DoDot:2
IF +ABPAZZ=0
QUIT
End DoDot:1
IF +ABPAZ=0
QUIT
+9 SET ABPAPTOT=ABPAP2+ABPAP3+ABPAP4+ABPAP5
SET ABPATPD=ABPATPD+ABPAPTOT
+10 SET ABPABAL=($PIECE(ABPADATA,"^",7)-ABPAPTOT)-(+$PIECE(ABPADATA,"^",3))
+11 SET $PIECE(ABPA("HP",ABPADOS,DA),"^")=ABPABAL
SET ABPAOBAL=ABPAOBAL+ABPABAL
+12 FOR ABPAJ=2:1:5
SET $PIECE(ABPA("HP",ABPADOS,DA),"^",ABPAJ)=@("ABPAP"_ABPAJ)
+13 SET $PIECE(ABPA("HP",ABPADOS,DA),"^",6)=ABPAPTOT
+14 SET $PIECE(ABPA("HP",ABPADOS,DA),"^",7)=+$PIECE(ABPADATA,"^",3)
+15 QUIT
UPDATE ;
+1 IF ABPA("C%")#.1'=0
IF ABPA("C%")=.02
WRITE "|"
WRITE "-"
+2 IF '$TEST
WRITE "|"
+3 SET ABPA("C%")=ABPA("C%")+.02
+4 QUIT
END ;
+1 FOR
IF ABPA("C%")>1
QUIT
DO UPDATE
+2 WRITE @ABPAROFF,!!?6,"Ending time: "
SET %H=$HOROLOG
DO YX^%DTC
WRITE $PIECE(Y,"@",2),!!
+3 KILL ABPATDFN,ABPADDFN,ABPA
KVARS ;
+1 KILL ABPACAMT,ABPACCNT,ABPA("HP"),ABPA("CP"),ABPA("PP"),ABPA("UP")
+2 KILL ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAP6,ABPAPTOT,ABPACDFN,ABPAY
+3 KILL ABPA("PB"),ABPA("NB"),ABPA("DB"),ABPA("SB"),ABPACTOB,ABPADOS
+4 KILL ABPACURB,ABPA("S$"),ABPA("N$"),ABPA("P$"),ABPA("D$"),ABPATCNT
+5 KILL ABPATBAL,ABPA("%"),ABPA("$"),ABPAD,ABPADATA,ABPAY,ABPAZ,ABPAZZ
+6 KILL ABPAT1,ABPAT2,ABPAT3,ABPAT4,ABPAT5,ABPAT6,ABPAH2,ABPAH3,ABPAH4
+7 KILL ABPAH5,ABPACURA,ABPAAPTR,X,ABPAPCOD,ABPADPTR,DA,ABPAPTR
+8 QUIT
