- 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
