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
