- AGCNVWC ; IHS/ASDS/EFG - WORKMAN'S COMP CONVERSION ROUTINE ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- D BMES^XPDUTL("Do not run from root tag! ")
- Q
- START ;EP -
- S RECORDS=+$P($G(^AUPNWRKC(0)),U,4)
- D BMES^XPDUTL(RECORDS_" records found in file 9000032")
- I 'RECORDS D BMES^XPDUTL("No records to transfer... transfer not done.") Q
- ;
- I $P($G(^AUPNWC(0)),U,4) D BMES^XPDUTL("Entries already transferred. Aborting transfer "),TS Q
- ;
- D READOLD ;LOOP THROUGH OLD FILE
- Q
- READOLD ;
- S PATIEN=0
- F S PATIEN=$O(^AUPNWRKC("C",PATIEN)) Q:PATIEN="" D
- .S RECORD=0
- .F S RECORD=$O(^AUPNWRKC("C",PATIEN,RECORD)) Q:'RECORD D
- ..S DATA0=$G(^AUPNWRKC(RECORD,0))
- ..S DATA1=$G(^AUPNWRKC(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 CLAIM=$P(DATA0,U,4) ;SET CATEGORY
- ..S CLAIMNUM=$P(DATA0,U,5) ;FREE TEXT
- ..S ATTORN=$P(DATA0,U,6) ;FREE TEXT
- ..S EMPLOYER=$P(DATA0,U,7) ;PTR TO 9999999.75
- ..S DTCLOSE=$P(DATA0,U,8) ;DATE CLOSED
- ..S TYPEACC=$P(DATA0,U,9) ;FREE TEXT
- ..S CLMSTAT=$P(DATA0,U,10) ;SET CATEGORY
- ..S ENTITY=$P(DATA0,U,11) ;PTR TO 9999999.18
- ..S GRPNAME=$P(DATA0,U,12) ;PTR TO 9999999.77
- ..S EFFDATE=$P(DATA0,U,13) ;FILEMAN DATE
- ..S ENDDATE=$P(DATA0,U,14)
- ..S NOTES=$P(DATA1,U) ;FREE TEXT
- ..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
- FINDINS(X,RECORD) ;FIND INSURER IN THE INSURER FILE
- 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
- ENTERNEW ;CREATE THE NEW RECORDS IN 'THIRD PART LIABILITY' FILE
- D CREATFDA ;SET UP THE FDA ARRAY
- D UPDATE^DIE("S","AGFDA","AGIEN","AGERROR")
- Q
- CREATFDA ;
- K AGFDA,AGIEN,AGERROR,AGRECORD
- I '$D(^AUPNWC(PAT)) D NEWONE
- E D ADDONE
- Q
- NEWONE ;
- S AGIEN(1)=PAT
- S AGRECORD="+2,+1,"
- S AGFDA(9000042,"+1,",.01)=PAT
- S AGFDA(9000042.11,AGRECORD,.01)=$G(DATEINJ)
- S AGFDA(9000042.11,AGRECORD,.02)=$G(DESCRIP)
- S AGFDA(9000042.11,AGRECORD,.03)=$G(CLAIM)
- S AGFDA(9000042.11,AGRECORD,.04)=$G(CLAIMNUM)
- S AGFDA(9000042.11,AGRECORD,.05)=$G(ATTORN)
- S AGFDA(9000042.11,AGRECORD,.06)=$G(EMPLOYER)
- S AGFDA(9000042.11,AGRECORD,.07)=$G(DTCLOSE)
- S AGFDA(9000042.11,AGRECORD,.08)=$G(TYPEACC)
- S AGFDA(9000042.11,AGRECORD,.09)=$G(CLMSTAT)
- S AGFDA(9000042.11,AGRECORD,.11)=$G(ENTITY)
- S AGFDA(9000042.11,AGRECORD,.12)=$G(GRPNAME)
- S AGFDA(9000042.11,AGRECORD,.13)=$G(EFFDATE)
- S AGFDA(9000042.11,AGRECORD,.14)=$G(ENDDATE)
- S AGFDA(9000042.11,AGRECORD,.15)=$G(NOTES)
- Q
- ADDONE ;
- S AGRECORD="+2,"_PAT_","
- S AGFDA(9000042.11,AGRECORD,.01)=$G(DATEINJ)
- S AGFDA(9000042.11,AGRECORD,.02)=$G(DESCRIP)
- S AGFDA(9000042.11,AGRECORD,.03)=$G(CLAIM)
- S AGFDA(9000042.11,AGRECORD,.04)=$G(CLAIMNUM)
- S AGFDA(9000042.11,AGRECORD,.05)=$G(ATTORN)
- S AGFDA(9000042.11,AGRECORD,.06)=$G(EMPLOYER)
- S AGFDA(9000042.11,AGRECORD,.07)=$G(DTCLOSE)
- S AGFDA(9000042.11,AGRECORD,.08)=$G(TYPEACC)
- S AGFDA(9000042.11,AGRECORD,.09)=$G(CLMSTAT)
- S AGFDA(9000042.11,AGRECORD,.11)=$G(ENTITY)
- S AGFDA(9000042.11,AGRECORD,.12)=$G(GRPNAME)
- S AGFDA(9000042.11,AGRECORD,.13)=$G(EFFDATE)
- S AGFDA(9000042.11,AGRECORD,.14)=$G(ENDDATE)
- S AGFDA(9000042.11,AGRECORD,.15)=$G(NOTES)
- Q
- AGCNVWC ; IHS/ASDS/EFG - WORKMAN'S COMP CONVERSION ROUTINE ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- +3 DO BMES^XPDUTL("Do not run from root tag! ")
- +4 QUIT
- START ;EP -
- +1 SET RECORDS=+$PIECE($GET(^AUPNWRKC(0)),U,4)
- +2 DO BMES^XPDUTL(RECORDS_" records found in file 9000032")
- +3 IF 'RECORDS
- DO BMES^XPDUTL("No records to transfer... transfer not done.")
- QUIT
- +4 ;
- +5 IF $PIECE($GET(^AUPNWC(0)),U,4)
- DO BMES^XPDUTL("Entries already transferred. Aborting transfer ")
- DO TS
- QUIT
- +6 ;
- +7 ;LOOP THROUGH OLD FILE
- DO READOLD
- +8 QUIT
- READOLD ;
- +1 SET PATIEN=0
- +2 FOR
- SET PATIEN=$ORDER(^AUPNWRKC("C",PATIEN))
- IF PATIEN=""
- QUIT
- Begin DoDot:1
- +3 SET RECORD=0
- +4 FOR
- SET RECORD=$ORDER(^AUPNWRKC("C",PATIEN,RECORD))
- IF 'RECORD
- QUIT
- Begin DoDot:2
- +5 SET DATA0=$GET(^AUPNWRKC(RECORD,0))
- +6 SET DATA1=$GET(^AUPNWRKC(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 ;SET CATEGORY
- SET CLAIM=$PIECE(DATA0,U,4)
- +11 ;FREE TEXT
- SET CLAIMNUM=$PIECE(DATA0,U,5)
- +12 ;FREE TEXT
- SET ATTORN=$PIECE(DATA0,U,6)
- +13 ;PTR TO 9999999.75
- SET EMPLOYER=$PIECE(DATA0,U,7)
- +14 ;DATE CLOSED
- SET DTCLOSE=$PIECE(DATA0,U,8)
- +15 ;FREE TEXT
- SET TYPEACC=$PIECE(DATA0,U,9)
- +16 ;SET CATEGORY
- SET CLMSTAT=$PIECE(DATA0,U,10)
- +17 ;PTR TO 9999999.18
- SET ENTITY=$PIECE(DATA0,U,11)
- +18 ;PTR TO 9999999.77
- SET GRPNAME=$PIECE(DATA0,U,12)
- +19 ;FILEMAN DATE
- SET EFFDATE=$PIECE(DATA0,U,13)
- +20 SET ENDDATE=$PIECE(DATA0,U,14)
- +21 ;FREE TEXT
- SET NOTES=$PIECE(DATA1,U)
- +22 ;CREATE NEW RECORDS IN NEW FILE WITH OLD DATA
- DO ENTERNEW
- End DoDot:2
- End DoDot:1
- +23 QUIT
- CONFIRM() ;
- +1 QUIT $DATA(^DIC(9000041,0))
- TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
- QUIT
- FINDINS(X,RECORD) ;FIND INSURER IN THE INSURER FILE
- +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
- ENTERNEW ;CREATE THE NEW RECORDS IN 'THIRD PART LIABILITY' FILE
- +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(^AUPNWC(PAT))
- DO NEWONE
- +3 IF '$TEST
- DO ADDONE
- +4 QUIT
- NEWONE ;
- +1 SET AGIEN(1)=PAT
- +2 SET AGRECORD="+2,+1,"
- +3 SET AGFDA(9000042,"+1,",.01)=PAT
- +4 SET AGFDA(9000042.11,AGRECORD,.01)=$GET(DATEINJ)
- +5 SET AGFDA(9000042.11,AGRECORD,.02)=$GET(DESCRIP)
- +6 SET AGFDA(9000042.11,AGRECORD,.03)=$GET(CLAIM)
- +7 SET AGFDA(9000042.11,AGRECORD,.04)=$GET(CLAIMNUM)
- +8 SET AGFDA(9000042.11,AGRECORD,.05)=$GET(ATTORN)
- +9 SET AGFDA(9000042.11,AGRECORD,.06)=$GET(EMPLOYER)
- +10 SET AGFDA(9000042.11,AGRECORD,.07)=$GET(DTCLOSE)
- +11 SET AGFDA(9000042.11,AGRECORD,.08)=$GET(TYPEACC)
- +12 SET AGFDA(9000042.11,AGRECORD,.09)=$GET(CLMSTAT)
- +13 SET AGFDA(9000042.11,AGRECORD,.11)=$GET(ENTITY)
- +14 SET AGFDA(9000042.11,AGRECORD,.12)=$GET(GRPNAME)
- +15 SET AGFDA(9000042.11,AGRECORD,.13)=$GET(EFFDATE)
- +16 SET AGFDA(9000042.11,AGRECORD,.14)=$GET(ENDDATE)
- +17 SET AGFDA(9000042.11,AGRECORD,.15)=$GET(NOTES)
- +18 QUIT
- ADDONE ;
- +1 SET AGRECORD="+2,"_PAT_","
- +2 SET AGFDA(9000042.11,AGRECORD,.01)=$GET(DATEINJ)
- +3 SET AGFDA(9000042.11,AGRECORD,.02)=$GET(DESCRIP)
- +4 SET AGFDA(9000042.11,AGRECORD,.03)=$GET(CLAIM)
- +5 SET AGFDA(9000042.11,AGRECORD,.04)=$GET(CLAIMNUM)
- +6 SET AGFDA(9000042.11,AGRECORD,.05)=$GET(ATTORN)
- +7 SET AGFDA(9000042.11,AGRECORD,.06)=$GET(EMPLOYER)
- +8 SET AGFDA(9000042.11,AGRECORD,.07)=$GET(DTCLOSE)
- +9 SET AGFDA(9000042.11,AGRECORD,.08)=$GET(TYPEACC)
- +10 SET AGFDA(9000042.11,AGRECORD,.09)=$GET(CLMSTAT)
- +11 SET AGFDA(9000042.11,AGRECORD,.11)=$GET(ENTITY)
- +12 SET AGFDA(9000042.11,AGRECORD,.12)=$GET(GRPNAME)
- +13 SET AGFDA(9000042.11,AGRECORD,.13)=$GET(EFFDATE)
- +14 SET AGFDA(9000042.11,AGRECORD,.14)=$GET(ENDDATE)
- +15 SET AGFDA(9000042.11,AGRECORD,.15)=$GET(NOTES)
- +16 QUIT
