PXRMV1IA ; SLC/PJH - Inits for new REMINDER package. ;04/10/2000
;;1.5;CLINICAL REMINDERS;;Jun 19, 2000
;
Q
;
;Copy Health Factor findings, Target Findings, Taxonomies
;to new sub-file FINDINGS
;---------------------------------------------------------
RBLD N CNT,DATA,IEN,FDAIEN,FDA,IND,MAP,NAME,PXRMCVRT,STRING
N SUB,SUB1,SUB2,WPTMP
S PXRMCVRT=1
; Get each reminder in turn
S IEN=0
F S IEN=$O(^PXD(811.9,IEN)) Q:'IEN D Q:$D(MSG)
.I $D(REDO) Q:IEN'=REMINDER
.K MAP,WPTMP
.S NAME=$P($G(^PXD(811.9,IEN,0)),U)
.;For testing
.;Skip VA-reminders - these will be broadcast
.I '$D(PXRMINST)&(NAME["VA-") Q
.;If reminder is converted skip - unless called from REDO^PXRMV1I
.I $$CONVDONE(IEN),'$D(REDO) D Q
..S STRING="Skipping conversion - reminder "_NAME
..D BMES^XPDUTL(" "),BMES^XPDUTL(STRING)
.;Remove existing entries
.D RMONE(IEN)
.;Build FDA array
.K FDAIEN,FDA
.S FDAIEN(1)=IEN,CNT=1
.S FDA(811.9,"?1,",.01)="`"_IEN
.S STRING="Converting findings in reminder "_NAME
.D BMES^XPDUTL(" "),BMES^XPDUTL(STRING)
.;Target findings
.D TARG(3)
.;Taxonomies
.D FIND(4)
.;Health Factor findings
.D FIND(6)
.;Computed findings
.D FIND(10)
.;Apply logic conversion
.D APPL(811.9,30)
.;Update ^PXD(811.9
.D UPDATE^DIE("S","FDA","FDAIEN","MSG")
.I $D(MSG) D ERR
Q
;
;Save Target findings to FDA
;---------------------------
TARG(TYP) ;
N IND,SUB1,DATA
S IND=0
F S IND=$O(^PXD(811.9,IEN,3,IND)) Q:'IND D
.;Target result finding item => findings item
.S SUB1=0
.F S SUB1=$O(^PXD(811.9,IEN,3,IND,2,SUB1)) Q:'SUB1 D
..S DATA=$G(^PXD(811.9,IEN,3,IND,2,SUB1,0)) Q:DATA=""
..S CNT=CNT+1,FDA(811.902,"+"_CNT_",?1,",.01)=DATA
..;Target result found text => finding found text
..D WFDA(3,3,811.902,4)
..;Target result not found text => finding not found text
..D WFDA(3,4,811.902,5)
..; Default 'Use in resolution logic' to OR
..D DFDA(811.902,7,"!")
Q
;
;Save other findings to FDA
;--------------------------
FIND(TYP) ;
N INC,IND,POINTER,OFFSET
;Computed findings record has an extra field (short desc.)
;INC is used to amend the PIECE variable when extracting CF data
S INC=0
; Taxonomies
I TYP=4 S POINTER="PXD(811.2,"
; Health Factors
I TYP=6 S POINTER="AUTTHF("
; Computed Findings
I TYP=10 S POINTER="PXRMD(811.4,",INC=1
;Move data entries into FDA
S IND=0
F S IND=$O(^PXD(811.9,IEN,TYP,IND)) Q:'IND D
.;pointer => findings item
.D SFDA(TYP,1,811.902,.01,POINTER)
.;Minimum age => minimum age
.D SFDA(TYP,2,811.902,1)
.;Maximum age => maximum age
.D SFDA(TYP,3,811.902,2)
.;Reminder frequency => reminder frequency
.D SFDA(TYP,4,811.902,3)
.;found text => finding found text
.D WFDA(TYP,1,811.902,4)
.;not found text => finding not found text
.D WFDA(TYP,2,811.902,5)
.;Rank frequency => rank frequency
.D SFDA(TYP,5+INC,811.902,6)
.;Use in date due => use in resolution logic (YES becomes OR)
.D SFDA(TYP,6+INC,811.902,7)
.;Use in apply logic => use in patient cohort logic
.D SFDA(TYP,7+INC,811.902,8)
.;Effective period => effective period
.D SFDA(TYP,8+INC,811.902,9)
.;Use inactive problems => use inactive problems
.D SFDA(TYP,9+INC,811.902,10)
Q
;
;Insert Defaults for new fields
;------------------------------
DFDA(FILE,FIELD,DATA) ;
S FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
Q
;
;Store multiple field entries in FDA
;-----------------------------------
MFDA(INODE,IND1,FILE,FIELD) ;
;
;Requires IEN and IND defined
;
N SUB1,DATA S SUB1=0
; Assemble fields into FDA array
F S SUB1=$O(^PXD(811.9,IEN,INODE,IND,IND1,SUB1)) Q:'SUB1 D
.S DATA=$G(^PXD(811.9,IEN,INODE,IND,IND1,SUB1,0)) Q:DATA=""
.S CNT=CNT+1,FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
Q
;
;Store single field entries in FDA
;---------------------------------
SFDA(INODE,PIECE,FILE,FIELD,POINTER) ;
;
;Requires IEN and IND defined
;
N DATA
S DATA=$G(^PXD(811.9,IEN,INODE,IND,0)) Q:DATA=""
;Extract data item from string
S DATA=$P(DATA,U,PIECE)
;If computed finding convert ROUTINE to CF IEN
I PIECE=1,INODE=10 S DATA=$$CHECK(DATA) Q:DATA=""
;The first piece must be converted to a variable pointer
I PIECE=1 D
.S CNT=CNT+1
.;Build mapping for Apply logic conversion
.I TYP'=10 S MAP(TYP,DATA)=CNT-1
.;For CF's store actual routine name
.I TYP=10 D
..N PROG,REF S REF=$P($G(^PXRMD(811.4,DATA,0)),U,2,3) Q:REF=""
..S PROG=$P(REF,U,2)_";"_$P(REF,U)
..S MAP(TYP,PROG)=CNT-1
.;Assemble pointer
.S DATA=DATA_";"_POINTER
;If Use in Date Due (Resolution) field - convert 1 to OR and 0 to null
I FIELD=7 S DATA=$S(DATA=1:"!",1:"")
;Store in FDA
S FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
Q
;
;Store WP entries in array WPTMP (create pointer from FDA)
;-------------------------------
WFDA(INODE,IND1,FILE,FIELD) ;
;
;Requires IEN,IND and TYP defined
;
N SUB1,DATA,FOUND
S SUB1=0,FOUND=0
; Assemble fields into FDA array
F S SUB1=$O(^PXD(811.9,IEN,INODE,IND,IND1,SUB1)) Q:'SUB1 D
.S DATA=$G(^PXD(811.9,IEN,INODE,IND,IND1,SUB1,0)) Q:DATA=""
.S:'FOUND FOUND=1
.S WPTMP(TYP,IND,IND1,SUB1)=DATA
I FOUND D
.S FDA(FILE,"+"_CNT_",?1,",FIELD)="WPTMP("_TYP_","_IND_","_IND1_")"
Q
;
;Convert Apply logic
;-------------------
APPL(FILE,FIELD) ;
;
; Requires IEN and MAP array
;
N DATA,CONV,NSUB,SUB,STR
;Get existing apply logic
S DATA=$G(^PXD(811.9,IEN,9)) Q:DATA=""
;Search for CF(nn),HF(nn) or TF(nn) entries and replace with FI(nnn)
;
N TYP,TXT,DONE
F TYP=4,6,10 D
.I TYP=4 S TXT="TF("
.I TYP=6 S TXT="HF("
.I TYP=10 S TXT="CF("
.S DONE=0
.F D Q:DONE
..I (TYP=4)!(TYP=6) D Q:DONE
...S SUB=+$P(DATA,TXT,2) I 'SUB S DONE=1
..I TYP=10 D Q:DONE
...S SUB=$P($P(DATA,TXT,2),")") I SUB="" S DONE=1
..S NSUB=+$G(MAP(TYP,SUB))
..I SUB="OBESE;PXRMOBES" S NSUB=+$G(MAP(TYP,"BMI;PXRMBMI"))
..S STR=TXT_SUB_")"
..I NSUB S DATA=$P(DATA,STR)_"FI("_NSUB_")"_$P(DATA,STR,2,99)
..I 'NSUB S DATA=$P(DATA,STR)_"FI(NOT FOUND)"_$P(DATA,STR,2,99)
;
;Give warning if unable to convert
I DATA["NOT FOUND" D Q
.N ERROR
.S ERROR(1)="Reminder : "_$P($G(^PXD(811.9,IEN,0)),U)
.S ERROR(2)="Unable to convert APPLY LOGIC due to finding not found"
.S ERROR(3)="APPLY LOGIC :"
.S ERROR(4)=$G(^PXD(811.9,IEN,9))
.S ERROR(5)="COHORT LOGIC:"
.S ERROR(6)=DATA
.;Screen message
.D BMES^XPDUTL(.ERROR)
.;Mail message
.D ERR^PXRMV1IE(.ERROR)
;
;Save modified apply logic in new field - cohort logic
S FDA(FILE,"?1,",FIELD)=DATA
Q
;
;Remove FINDING entries for one reminder
;---------------------------------------
RMONE(IEN) ;
N DA,IND,NAME
S NAME=$P(^PXD(811.9,IEN,0),U,1)
S DA(1)=IEN
S IND=""
F S IND=$O(^PXD(811.9,IEN,20,"B",IND)) Q:IND="" D
.S DA=0
.F S DA=$O(^PXD(811.9,IEN,20,"B",IND,DA)) Q:+DA=0 D
..S DIK="^PXD(811.9,"_IEN_","_20_"," D ^DIK
Q
;
;See if conversion has already been done
;---------------------------------------
CONVDONE(IEN) ;
;If no finding entries exist conversion has not been done
I +$D(^PXD(811.9,IEN,20))=0 Q 0
Q 1
;Count finding file entries
;N FIND,IC
;S FIND=0,IC=0
;F S IC=$O(^PXD(811.9,IEN,20,IC)) Q:'IC D
;.S FIND=FIND+1
;;Count Target Findings
;N SUB,PRIOR
;S PRIOR=0,SUB=0
;F S SUB=$O(^PXD(811.9,IEN,3,SUB)) Q:'SUB D
;.S IC=0
;.F S IC=$O(^PXD(811.9,IEN,3,SUB,2,IC)) Q:'IC D
;..S PRIOR=PRIOR+1
;;Count Taxonomies,Health Factors and Computed Findings
;F SUB=4,6,10 D
;.S IC=0
;.F S IC=$O(^PXD(811.9,IEN,SUB,IC)) Q:'IC D
;..S PRIOR=PRIOR+1
;;Check if count of findings matches prior entries conversion complete
;I PRIOR=0 Q 1
;I (PRIOR>0)&(PRIOR=FIND) Q 1
;Otherwise not complete and must be re-run
Q 0
;
;Search for routine entry point in the new computed findings file
;----------------------------------------------------------------
CHECK(ROUTINE) ;
N BMI,SUB,TAG,FOUND
;Convert PXRMOBES to VA-BMI
S BMI=$O(^PXRMD(811.4,"B","VA-BMI",""))
I (ROUTINE="OBESE;PXRMOBES"),BMI Q BMI
;Otherwise get ien of CF
S SUB=0,FOUND=""
F S SUB=$O(^PXRMD(811.4,SUB)) Q:'SUB D Q:FOUND]""
.S TAG=$P($G(^PXRMD(811.4,SUB,0)),U,2,3)
.I $P(TAG,U,2)_";"_$P(TAG,U)=ROUTINE S FOUND=SUB
Q FOUND
;
;Error Handler
;-------------
ERR N ERROR,IC,REF
S ERROR(1)="Unable to convert reminder : "_$P($G(^PXD(811.9,IEN,0)),U)
S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
;Move MSG into ERROR
S REF="MSG"
F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
;Screen message
D BMES^XPDUTL(.ERROR)
;Mail Message
D ERR^PXRMV1IE(.ERROR)
Q
PXRMV1IA ; SLC/PJH - Inits for new REMINDER package. ;04/10/2000
+1 ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000
+2 ;
+3 QUIT
+4 ;
+5 ;Copy Health Factor findings, Target Findings, Taxonomies
+6 ;to new sub-file FINDINGS
+7 ;---------------------------------------------------------
RBLD NEW CNT,DATA,IEN,FDAIEN,FDA,IND,MAP,NAME,PXRMCVRT,STRING
+1 NEW SUB,SUB1,SUB2,WPTMP
+2 SET PXRMCVRT=1
+3 ; Get each reminder in turn
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^PXD(811.9,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 IF $DATA(REDO)
IF IEN'=REMINDER
QUIT
+7 KILL MAP,WPTMP
+8 SET NAME=$PIECE($GET(^PXD(811.9,IEN,0)),U)
+9 ;For testing
+10 ;Skip VA-reminders - these will be broadcast
+11 IF '$DATA(PXRMINST)&(NAME["VA-")
QUIT
+12 ;If reminder is converted skip - unless called from REDO^PXRMV1I
+13 IF $$CONVDONE(IEN)
IF '$DATA(REDO)
Begin DoDot:2
+14 SET STRING="Skipping conversion - reminder "_NAME
+15 DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(STRING)
End DoDot:2
QUIT
+16 ;Remove existing entries
+17 DO RMONE(IEN)
+18 ;Build FDA array
+19 KILL FDAIEN,FDA
+20 SET FDAIEN(1)=IEN
SET CNT=1
+21 SET FDA(811.9,"?1,",.01)="`"_IEN
+22 SET STRING="Converting findings in reminder "_NAME
+23 DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(STRING)
+24 ;Target findings
+25 DO TARG(3)
+26 ;Taxonomies
+27 DO FIND(4)
+28 ;Health Factor findings
+29 DO FIND(6)
+30 ;Computed findings
+31 DO FIND(10)
+32 ;Apply logic conversion
+33 DO APPL(811.9,30)
+34 ;Update ^PXD(811.9
+35 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
+36 IF $DATA(MSG)
DO ERR
End DoDot:1
IF $DATA(MSG)
QUIT
+37 QUIT
+38 ;
+39 ;Save Target findings to FDA
+40 ;---------------------------
TARG(TYP) ;
+1 NEW IND,SUB1,DATA
+2 SET IND=0
+3 FOR
SET IND=$ORDER(^PXD(811.9,IEN,3,IND))
IF 'IND
QUIT
Begin DoDot:1
+4 ;Target result finding item => findings item
+5 SET SUB1=0
+6 FOR
SET SUB1=$ORDER(^PXD(811.9,IEN,3,IND,2,SUB1))
IF 'SUB1
QUIT
Begin DoDot:2
+7 SET DATA=$GET(^PXD(811.9,IEN,3,IND,2,SUB1,0))
IF DATA=""
QUIT
+8 SET CNT=CNT+1
SET FDA(811.902,"+"_CNT_",?1,",.01)=DATA
+9 ;Target result found text => finding found text
+10 DO WFDA(3,3,811.902,4)
+11 ;Target result not found text => finding not found text
+12 DO WFDA(3,4,811.902,5)
+13 ; Default 'Use in resolution logic' to OR
+14 DO DFDA(811.902,7,"!")
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;Save other findings to FDA
+18 ;--------------------------
FIND(TYP) ;
+1 NEW INC,IND,POINTER,OFFSET
+2 ;Computed findings record has an extra field (short desc.)
+3 ;INC is used to amend the PIECE variable when extracting CF data
+4 SET INC=0
+5 ; Taxonomies
+6 IF TYP=4
SET POINTER="PXD(811.2,"
+7 ; Health Factors
+8 IF TYP=6
SET POINTER="AUTTHF("
+9 ; Computed Findings
+10 IF TYP=10
SET POINTER="PXRMD(811.4,"
SET INC=1
+11 ;Move data entries into FDA
+12 SET IND=0
+13 FOR
SET IND=$ORDER(^PXD(811.9,IEN,TYP,IND))
IF 'IND
QUIT
Begin DoDot:1
+14 ;pointer => findings item
+15 DO SFDA(TYP,1,811.902,.01,POINTER)
+16 ;Minimum age => minimum age
+17 DO SFDA(TYP,2,811.902,1)
+18 ;Maximum age => maximum age
+19 DO SFDA(TYP,3,811.902,2)
+20 ;Reminder frequency => reminder frequency
+21 DO SFDA(TYP,4,811.902,3)
+22 ;found text => finding found text
+23 DO WFDA(TYP,1,811.902,4)
+24 ;not found text => finding not found text
+25 DO WFDA(TYP,2,811.902,5)
+26 ;Rank frequency => rank frequency
+27 DO SFDA(TYP,5+INC,811.902,6)
+28 ;Use in date due => use in resolution logic (YES becomes OR)
+29 DO SFDA(TYP,6+INC,811.902,7)
+30 ;Use in apply logic => use in patient cohort logic
+31 DO SFDA(TYP,7+INC,811.902,8)
+32 ;Effective period => effective period
+33 DO SFDA(TYP,8+INC,811.902,9)
+34 ;Use inactive problems => use inactive problems
+35 DO SFDA(TYP,9+INC,811.902,10)
End DoDot:1
+36 QUIT
+37 ;
+38 ;Insert Defaults for new fields
+39 ;------------------------------
DFDA(FILE,FIELD,DATA) ;
+1 SET FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
+2 QUIT
+3 ;
+4 ;Store multiple field entries in FDA
+5 ;-----------------------------------
MFDA(INODE,IND1,FILE,FIELD) ;
+1 ;
+2 ;Requires IEN and IND defined
+3 ;
+4 NEW SUB1,DATA
SET SUB1=0
+5 ; Assemble fields into FDA array
+6 FOR
SET SUB1=$ORDER(^PXD(811.9,IEN,INODE,IND,IND1,SUB1))
IF 'SUB1
QUIT
Begin DoDot:1
+7 SET DATA=$GET(^PXD(811.9,IEN,INODE,IND,IND1,SUB1,0))
IF DATA=""
QUIT
+8 SET CNT=CNT+1
SET FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
End DoDot:1
+9 QUIT
+10 ;
+11 ;Store single field entries in FDA
+12 ;---------------------------------
SFDA(INODE,PIECE,FILE,FIELD,POINTER) ;
+1 ;
+2 ;Requires IEN and IND defined
+3 ;
+4 NEW DATA
+5 SET DATA=$GET(^PXD(811.9,IEN,INODE,IND,0))
IF DATA=""
QUIT
+6 ;Extract data item from string
+7 SET DATA=$PIECE(DATA,U,PIECE)
+8 ;If computed finding convert ROUTINE to CF IEN
+9 IF PIECE=1
IF INODE=10
SET DATA=$$CHECK(DATA)
IF DATA=""
QUIT
+10 ;The first piece must be converted to a variable pointer
+11 IF PIECE=1
Begin DoDot:1
+12 SET CNT=CNT+1
+13 ;Build mapping for Apply logic conversion
+14 IF TYP'=10
SET MAP(TYP,DATA)=CNT-1
+15 ;For CF's store actual routine name
+16 IF TYP=10
Begin DoDot:2
+17 NEW PROG,REF
SET REF=$PIECE($GET(^PXRMD(811.4,DATA,0)),U,2,3)
IF REF=""
QUIT
+18 SET PROG=$PIECE(REF,U,2)_";"_$PIECE(REF,U)
+19 SET MAP(TYP,PROG)=CNT-1
End DoDot:2
+20 ;Assemble pointer
+21 SET DATA=DATA_";"_POINTER
End DoDot:1
+22 ;If Use in Date Due (Resolution) field - convert 1 to OR and 0 to null
+23 IF FIELD=7
SET DATA=$SELECT(DATA=1:"!",1:"")
+24 ;Store in FDA
+25 SET FDA(FILE,"+"_CNT_",?1,",FIELD)=DATA
+26 QUIT
+27 ;
+28 ;Store WP entries in array WPTMP (create pointer from FDA)
+29 ;-------------------------------
WFDA(INODE,IND1,FILE,FIELD) ;
+1 ;
+2 ;Requires IEN,IND and TYP defined
+3 ;
+4 NEW SUB1,DATA,FOUND
+5 SET SUB1=0
SET FOUND=0
+6 ; Assemble fields into FDA array
+7 FOR
SET SUB1=$ORDER(^PXD(811.9,IEN,INODE,IND,IND1,SUB1))
IF 'SUB1
QUIT
Begin DoDot:1
+8 SET DATA=$GET(^PXD(811.9,IEN,INODE,IND,IND1,SUB1,0))
IF DATA=""
QUIT
+9 IF 'FOUND
SET FOUND=1
+10 SET WPTMP(TYP,IND,IND1,SUB1)=DATA
End DoDot:1
+11 IF FOUND
Begin DoDot:1
+12 SET FDA(FILE,"+"_CNT_",?1,",FIELD)="WPTMP("_TYP_","_IND_","_IND1_")"
End DoDot:1
+13 QUIT
+14 ;
+15 ;Convert Apply logic
+16 ;-------------------
APPL(FILE,FIELD) ;
+1 ;
+2 ; Requires IEN and MAP array
+3 ;
+4 NEW DATA,CONV,NSUB,SUB,STR
+5 ;Get existing apply logic
+6 SET DATA=$GET(^PXD(811.9,IEN,9))
IF DATA=""
QUIT
+7 ;Search for CF(nn),HF(nn) or TF(nn) entries and replace with FI(nnn)
+8 ;
+9 NEW TYP,TXT,DONE
+10 FOR TYP=4,6,10
Begin DoDot:1
+11 IF TYP=4
SET TXT="TF("
+12 IF TYP=6
SET TXT="HF("
+13 IF TYP=10
SET TXT="CF("
+14 SET DONE=0
+15 FOR
Begin DoDot:2
+16 IF (TYP=4)!(TYP=6)
Begin DoDot:3
+17 SET SUB=+$PIECE(DATA,TXT,2)
IF 'SUB
SET DONE=1
End DoDot:3
IF DONE
QUIT
+18 IF TYP=10
Begin DoDot:3
+19 SET SUB=$PIECE($PIECE(DATA,TXT,2),")")
IF SUB=""
SET DONE=1
End DoDot:3
IF DONE
QUIT
+20 SET NSUB=+$GET(MAP(TYP,SUB))
+21 IF SUB="OBESE;PXRMOBES"
SET NSUB=+$GET(MAP(TYP,"BMI;PXRMBMI"))
+22 SET STR=TXT_SUB_")"
+23 IF NSUB
SET DATA=$PIECE(DATA,STR)_"FI("_NSUB_")"_$PIECE(DATA,STR,2,99)
+24 IF 'NSUB
SET DATA=$PIECE(DATA,STR)_"FI(NOT FOUND)"_$PIECE(DATA,STR,2,99)
End DoDot:2
IF DONE
QUIT
End DoDot:1
+25 ;
+26 ;Give warning if unable to convert
+27 IF DATA["NOT FOUND"
Begin DoDot:1
+28 NEW ERROR
+29 SET ERROR(1)="Reminder : "_$PIECE($GET(^PXD(811.9,IEN,0)),U)
+30 SET ERROR(2)="Unable to convert APPLY LOGIC due to finding not found"
+31 SET ERROR(3)="APPLY LOGIC :"
+32 SET ERROR(4)=$GET(^PXD(811.9,IEN,9))
+33 SET ERROR(5)="COHORT LOGIC:"
+34 SET ERROR(6)=DATA
+35 ;Screen message
+36 DO BMES^XPDUTL(.ERROR)
+37 ;Mail message
+38 DO ERR^PXRMV1IE(.ERROR)
End DoDot:1
QUIT
+39 ;
+40 ;Save modified apply logic in new field - cohort logic
+41 SET FDA(FILE,"?1,",FIELD)=DATA
+42 QUIT
+43 ;
+44 ;Remove FINDING entries for one reminder
+45 ;---------------------------------------
RMONE(IEN) ;
+1 NEW DA,IND,NAME
+2 SET NAME=$PIECE(^PXD(811.9,IEN,0),U,1)
+3 SET DA(1)=IEN
+4 SET IND=""
+5 FOR
SET IND=$ORDER(^PXD(811.9,IEN,20,"B",IND))
IF IND=""
QUIT
Begin DoDot:1
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^PXD(811.9,IEN,20,"B",IND,DA))
IF +DA=0
QUIT
Begin DoDot:2
+8 SET DIK="^PXD(811.9,"_IEN_","_20_","
DO ^DIK
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;See if conversion has already been done
+12 ;---------------------------------------
CONVDONE(IEN) ;
+1 ;If no finding entries exist conversion has not been done
+2 IF +$DATA(^PXD(811.9,IEN,20))=0
QUIT 0
+3 QUIT 1
+4 ;Count finding file entries
+5 ;N FIND,IC
+6 ;S FIND=0,IC=0
+7 ;F S IC=$O(^PXD(811.9,IEN,20,IC)) Q:'IC D
+8 ;.S FIND=FIND+1
+9 ;;Count Target Findings
+10 ;N SUB,PRIOR
+11 ;S PRIOR=0,SUB=0
+12 ;F S SUB=$O(^PXD(811.9,IEN,3,SUB)) Q:'SUB D
+13 ;.S IC=0
+14 ;.F S IC=$O(^PXD(811.9,IEN,3,SUB,2,IC)) Q:'IC D
+15 ;..S PRIOR=PRIOR+1
+16 ;;Count Taxonomies,Health Factors and Computed Findings
+17 ;F SUB=4,6,10 D
+18 ;.S IC=0
+19 ;.F S IC=$O(^PXD(811.9,IEN,SUB,IC)) Q:'IC D
+20 ;..S PRIOR=PRIOR+1
+21 ;;Check if count of findings matches prior entries conversion complete
+22 ;I PRIOR=0 Q 1
+23 ;I (PRIOR>0)&(PRIOR=FIND) Q 1
+24 ;Otherwise not complete and must be re-run
+25 QUIT 0
+26 ;
+27 ;Search for routine entry point in the new computed findings file
+28 ;----------------------------------------------------------------
CHECK(ROUTINE) ;
+1 NEW BMI,SUB,TAG,FOUND
+2 ;Convert PXRMOBES to VA-BMI
+3 SET BMI=$ORDER(^PXRMD(811.4,"B","VA-BMI",""))
+4 IF (ROUTINE="OBESE;PXRMOBES")
IF BMI
QUIT BMI
+5 ;Otherwise get ien of CF
+6 SET SUB=0
SET FOUND=""
+7 FOR
SET SUB=$ORDER(^PXRMD(811.4,SUB))
IF 'SUB
QUIT
Begin DoDot:1
+8 SET TAG=$PIECE($GET(^PXRMD(811.4,SUB,0)),U,2,3)
+9 IF $PIECE(TAG,U,2)_";"_$PIECE(TAG,U)=ROUTINE
SET FOUND=SUB
End DoDot:1
IF FOUND]""
QUIT
+10 QUIT FOUND
+11 ;
+12 ;Error Handler
+13 ;-------------
ERR NEW ERROR,IC,REF
+1 SET ERROR(1)="Unable to convert reminder : "_$PIECE($GET(^PXD(811.9,IEN,0)),U)
+2 SET ERROR(2)="Error in UPDATE^DIE, needs further investigation"
+3 ;Move MSG into ERROR
+4 SET REF="MSG"
+5 FOR IC=3:1
SET REF=$QUERY(@REF)
IF REF=""
QUIT
SET ERROR(IC)=REF_"="_@REF
+6 ;Screen message
+7 DO BMES^XPDUTL(.ERROR)
+8 ;Mail Message
+9 DO ERR^PXRMV1IE(.ERROR)
+10 QUIT
