AGCNVTPL ; IHS/ASDS/EFG - THIRD PART LIABILITY CONVERSION ROUTINE 3/26/2004 8:10:41 AM
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;USE AS A POST INSTALL TO TRANSFER ENTRIES FROM THE AUTO/LIABILITY FILE TO
;THE NEW THIRD PART LIABILITY FILE
;
D BMES^XPDUTL("Beginning post-install routine (AGTPLTR). "),TS
I '$$CONFIRM D BMES^XPDUTL("New file 9000041 cannot be found transfer aborted!!") Q
;
I $P($G(^AUPNTPL(0)),U,4) D BMES^XPDUTL("Entries already transferred. Aborting transfer "),TS Q
;
S RECORDS=+$P($G(^AUPNAUTO(0)),U,4)
D BMES^XPDUTL(RECORDS_" records found in file 9000031")
I 'RECORDS D BMES^XPDUTL("No records to transfer... transfer not done.") Q
;
D READOLD ;LOOP THROUGH OLD FILE
Q
READOLD ;
S PATIEN=0
F S PATIEN=$O(^AUPNAUTO("C",PATIEN)) Q:PATIEN="" D
.S RECORD=0
.F S RECORD=$O(^AUPNAUTO("C",PATIEN,RECORD)) Q:'RECORD D
..S DATA0=$G(^AUPNAUTO(RECORD,0))
..S DATA1=$G(^AUPNAUTO(RECORD,1))
..S DATEINJ=$P(DATA0,U) ;FILEMAN DATE 3040323
..S PAT=$P(DATA0,U,2) ;PTR TO 9000001
..S DESCRIP=$P(DATA0,U,3) ;FREE TEXT
..S INSCOMP=$P(DATA0,U,4) ;FREE TEXT LOOK FOR IN INSURER FILE
..S POLNUM=$P(DATA0,U,5) ;FREE TEXT
..S ATTORN=$P(DATA0,U,6) ;FREE TEXT
..S RESPSSN=$P(DATA0,U,7) ;FREE TEXT
..S CAUSE=$P(DATA0,U,8) ;FREE TEXT
..S RESPNAM=$P(DATA1,U) ;FREE TEXT
..S EFFDATE=$P(DATA1,U,2) ;FILEMAN DATE 3040323
..S ENDDATE=$P(DATA1,U,3) ;FILEMAN DATE 3040323
..S GRPNAME=$P(DATA1,U,4) ;PTR TO 9999999.77
..S NOTES=$P(DATA1,U,5) ;FREE TEXT
..I INSCOMP'="" D FINDINS(INSCOMP,RECORD) ;FIND A MATCH FOR THE INSURER IN THE INSURER FILE
..D ENTERNEW ;CREATE NEW RECORDS IN NEW FILE WITH OLD DATA
Q
CONFIRM() ;
Q $D(^DIC(9000041,0))
TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
;FIND INSURER IN THE INSURER FILE
FINDINS(X,RECORD) ;
K INSCOMPP ;INSURANCE COMPANY POINTER
D SEARCH(X)
Q
SEARCH(X) ;
S GLO="^AUTNINS(0)"
F S GLO=$Q(@GLO) Q:GLO="" Q:'(+$P($P(GLO,","),"(",2)) D Q:$D(INSCOMPP)
. I $P(@GLO,U)=X S FREC=$P($P(GLO,","),"(",2) S INSCOMPP=FREC D DISPLAY(GLO,FREC,1,X) Q
. I @GLO[X S FREC=$P($P(GLO,","),"(",2) S INSCOMPP=FREC D DISPLAY(GLO,FREC,2,X) Q
Q
DISPLAY(GLO,FREC,MSG,KEYWORD) ;
W !!,$S(MSG=1:"Exact ",MSG=2:"Possible ",1:"Unknown msg")_" match for KEYWORD="_KEYWORD_" in record "_RECORD_" in AUTO/LIABILITY file found in INSURER file at ien "_FREC_" "_$P(@GLO,U)
Q
;CREATE THE NEW RECORDS IN 'THIRD PART LIABILITY' FILE
ENTERNEW ;
D CREATFDA ;SET UP THE FDA ARRAY
D UPDATE^DIE("S","AGFDA","AGIEN","AGERROR")
Q
CREATFDA ;
K AGFDA,AGIEN,AGERROR,AGRECORD
I '$D(^AUPNTPL(PAT)) D NEWONE
E D ADDONE
Q
NEWONE ;
S AGIEN(1)=PAT
S AGRECORD="+2,+1,"
S AGFDA(9000041,"+1,",.01)=PAT
S AGFDA(9000041.0101,AGRECORD,.01)=$G(DATEINJ)
S AGFDA(9000041.0101,AGRECORD,.02)=$G(INSCOMPP)
S AGFDA(9000041.0101,AGRECORD,.03)=$G(POLNUM)
S AGFDA(9000041.0101,AGRECORD,.04)=$G(EFFDATE)
S AGFDA(9000041.0101,AGRECORD,.05)=$G(ENDDATE)
S AGFDA(9000041.0101,AGRECORD,.06)=$G(GRPNAME)
S AGFDA(9000041.0101,AGRECORD,101)=$G(RESPNAM)
S AGFDA(9000041.0101,AGRECORD,102)=$G(RESPSSN)
S AGFDA(9000041.0101,AGRECORD,103)=$G(ATTORN)
S AGFDA(9000041.0101,AGRECORD,104)=$G(CAUSE)
S AGFDA(9000041.0101,AGRECORD,105)=$G(DESCRIP)
S AGFDA(9000041.0101,AGRECORD,106)=$G(NOTES)
Q
ADDONE ;
S AGRECORD="+2,"_PAT_","
S AGFDA(9000041.0101,AGRECORD,.01)=$G(DATEINJ)
S AGFDA(9000041.0101,AGRECORD,.02)=$G(INSCOMPP)
S AGFDA(9000041.0101,AGRECORD,.03)=$G(POLNUM)
S AGFDA(9000041.0101,AGRECORD,.04)=$G(EFFDATE)
S AGFDA(9000041.0101,AGRECORD,.05)=$G(ENDDATE)
S AGFDA(9000041.0101,AGRECORD,.06)=$G(GRPNAME)
S AGFDA(9000041.0101,AGRECORD,101)=$G(RESPNAM)
S AGFDA(9000041.0101,AGRECORD,102)=$G(RESPSSN)
S AGFDA(9000041.0101,AGRECORD,103)=$G(ATTORN)
S AGFDA(9000041.0101,AGRECORD,104)=$G(CAUSE)
S AGFDA(9000041.0101,AGRECORD,105)=$G(DESCRIP)
S AGFDA(9000041.0101,AGRECORD,106)=$G(NOTES)
Q
AGCNVTPL ; IHS/ASDS/EFG - THIRD PART LIABILITY CONVERSION ROUTINE 3/26/2004 8:10:41 AM
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;USE AS A POST INSTALL TO TRANSFER ENTRIES FROM THE AUTO/LIABILITY FILE TO
+3 ;THE NEW THIRD PART LIABILITY FILE
+4 ;
+5 DO BMES^XPDUTL("Beginning post-install routine (AGTPLTR). ")
DO TS
+6 IF '$$CONFIRM
DO BMES^XPDUTL("New file 9000041 cannot be found transfer aborted!!")
QUIT
+7 ;
+8 IF $PIECE($GET(^AUPNTPL(0)),U,4)
DO BMES^XPDUTL("Entries already transferred. Aborting transfer ")
DO TS
QUIT
+9 ;
+10 SET RECORDS=+$PIECE($GET(^AUPNAUTO(0)),U,4)
+11 DO BMES^XPDUTL(RECORDS_" records found in file 9000031")
+12 IF 'RECORDS
DO BMES^XPDUTL("No records to transfer... transfer not done.")
QUIT
+13 ;
+14 ;LOOP THROUGH OLD FILE
DO READOLD
+15 QUIT
READOLD ;
+1 SET PATIEN=0
+2 FOR
SET PATIEN=$ORDER(^AUPNAUTO("C",PATIEN))
IF PATIEN=""
QUIT
Begin DoDot:1
+3 SET RECORD=0
+4 FOR
SET RECORD=$ORDER(^AUPNAUTO("C",PATIEN,RECORD))
IF 'RECORD
QUIT
Begin DoDot:2
+5 SET DATA0=$GET(^AUPNAUTO(RECORD,0))
+6 SET DATA1=$GET(^AUPNAUTO(RECORD,1))
+7 ;FILEMAN DATE 3040323
SET DATEINJ=$PIECE(DATA0,U)
+8 ;PTR TO 9000001
SET PAT=$PIECE(DATA0,U,2)
+9 ;FREE TEXT
SET DESCRIP=$PIECE(DATA0,U,3)
+10 ;FREE TEXT LOOK FOR IN INSURER FILE
SET INSCOMP=$PIECE(DATA0,U,4)
+11 ;FREE TEXT
SET POLNUM=$PIECE(DATA0,U,5)
+12 ;FREE TEXT
SET ATTORN=$PIECE(DATA0,U,6)
+13 ;FREE TEXT
SET RESPSSN=$PIECE(DATA0,U,7)
+14 ;FREE TEXT
SET CAUSE=$PIECE(DATA0,U,8)
+15 ;FREE TEXT
SET RESPNAM=$PIECE(DATA1,U)
+16 ;FILEMAN DATE 3040323
SET EFFDATE=$PIECE(DATA1,U,2)
+17 ;FILEMAN DATE 3040323
SET ENDDATE=$PIECE(DATA1,U,3)
+18 ;PTR TO 9999999.77
SET GRPNAME=$PIECE(DATA1,U,4)
+19 ;FREE TEXT
SET NOTES=$PIECE(DATA1,U,5)
+20 ;FIND A MATCH FOR THE INSURER IN THE INSURER FILE
IF INSCOMP'=""
DO FINDINS(INSCOMP,RECORD)
+21 ;CREATE NEW RECORDS IN NEW FILE WITH OLD DATA
DO ENTERNEW
End DoDot:2
End DoDot:1
+22 QUIT
CONFIRM() ;
+1 QUIT $DATA(^DIC(9000041,0))
TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
QUIT
+1 ;FIND INSURER IN THE INSURER FILE
FINDINS(X,RECORD) ;
+1 ;INSURANCE COMPANY POINTER
KILL INSCOMPP
+2 DO SEARCH(X)
+3 QUIT
SEARCH(X) ;
+1 SET GLO="^AUTNINS(0)"
+2 FOR
SET GLO=$QUERY(@GLO)
IF GLO=""
QUIT
IF '(+$PIECE($PIECE(GLO,","),"(",2))
QUIT
Begin DoDot:1
+3 IF $PIECE(@GLO,U)=X
SET FREC=$PIECE($PIECE(GLO,","),"(",2)
SET INSCOMPP=FREC
DO DISPLAY(GLO,FREC,1,X)
QUIT
+4 IF @GLO[X
SET FREC=$PIECE($PIECE(GLO,","),"(",2)
SET INSCOMPP=FREC
DO DISPLAY(GLO,FREC,2,X)
QUIT
End DoDot:1
IF $DATA(INSCOMPP)
QUIT
+5 QUIT
DISPLAY(GLO,FREC,MSG,KEYWORD) ;
+1 WRITE !!,$SELECT(MSG=1:"Exact ",MSG=2:"Possible ",1:"Unknown msg")_" match for KEYWORD="_KEYWORD_" in record "_RECORD_" in AUTO/LIABILITY file found in INSURER file at ien "_FREC_" "_$PIECE(@GLO,U)
+2 QUIT
+3 ;CREATE THE NEW RECORDS IN 'THIRD PART LIABILITY' FILE
ENTERNEW ;
+1 ;SET UP THE FDA ARRAY
DO CREATFDA
+2 DO UPDATE^DIE("S","AGFDA","AGIEN","AGERROR")
+3 QUIT
CREATFDA ;
+1 KILL AGFDA,AGIEN,AGERROR,AGRECORD
+2 IF '$DATA(^AUPNTPL(PAT))
DO NEWONE
+3 IF '$TEST
DO ADDONE
+4 QUIT
NEWONE ;
+1 SET AGIEN(1)=PAT
+2 SET AGRECORD="+2,+1,"
+3 SET AGFDA(9000041,"+1,",.01)=PAT
+4 SET AGFDA(9000041.0101,AGRECORD,.01)=$GET(DATEINJ)
+5 SET AGFDA(9000041.0101,AGRECORD,.02)=$GET(INSCOMPP)
+6 SET AGFDA(9000041.0101,AGRECORD,.03)=$GET(POLNUM)
+7 SET AGFDA(9000041.0101,AGRECORD,.04)=$GET(EFFDATE)
+8 SET AGFDA(9000041.0101,AGRECORD,.05)=$GET(ENDDATE)
+9 SET AGFDA(9000041.0101,AGRECORD,.06)=$GET(GRPNAME)
+10 SET AGFDA(9000041.0101,AGRECORD,101)=$GET(RESPNAM)
+11 SET AGFDA(9000041.0101,AGRECORD,102)=$GET(RESPSSN)
+12 SET AGFDA(9000041.0101,AGRECORD,103)=$GET(ATTORN)
+13 SET AGFDA(9000041.0101,AGRECORD,104)=$GET(CAUSE)
+14 SET AGFDA(9000041.0101,AGRECORD,105)=$GET(DESCRIP)
+15 SET AGFDA(9000041.0101,AGRECORD,106)=$GET(NOTES)
+16 QUIT
ADDONE ;
+1 SET AGRECORD="+2,"_PAT_","
+2 SET AGFDA(9000041.0101,AGRECORD,.01)=$GET(DATEINJ)
+3 SET AGFDA(9000041.0101,AGRECORD,.02)=$GET(INSCOMPP)
+4 SET AGFDA(9000041.0101,AGRECORD,.03)=$GET(POLNUM)
+5 SET AGFDA(9000041.0101,AGRECORD,.04)=$GET(EFFDATE)
+6 SET AGFDA(9000041.0101,AGRECORD,.05)=$GET(ENDDATE)
+7 SET AGFDA(9000041.0101,AGRECORD,.06)=$GET(GRPNAME)
+8 SET AGFDA(9000041.0101,AGRECORD,101)=$GET(RESPNAM)
+9 SET AGFDA(9000041.0101,AGRECORD,102)=$GET(RESPSSN)
+10 SET AGFDA(9000041.0101,AGRECORD,103)=$GET(ATTORN)
+11 SET AGFDA(9000041.0101,AGRECORD,104)=$GET(CAUSE)
+12 SET AGFDA(9000041.0101,AGRECORD,105)=$GET(DESCRIP)
+13 SET AGFDA(9000041.0101,AGRECORD,106)=$GET(NOTES)
+14 QUIT
