- 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
