Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMV1IA

PXRMV1IA.m

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