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

PXRMP26X.m

Go to the documentation of this file. 
  1. PXRMP26X ;SLC/AGP - Dialog Conversion Extra routine for PXRM*2.0*26. ;01/02/2014
  1.  ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
  1.  Q
  1.  ;
  1.  ;build an XTMP value of dialogs that contains Taxonomy, ICD9 codes, and/or CPT codes.
  1.  ;if ICD9 or CPT deletes the values from file 801.41
  1. BLDLIST(PXRMSKIP) ;
  1.  K ^TMP($J,"DLG FIND"),^TMP($J,"DLG ORDER")
  1.  D MES^XPDUTL("Building lists of dialogs to update")
  1.  D BLDDLGTM^PXRMSTS("DLG FIND")
  1.  N ADD,ADDFNDS,ADDFVPL,CNT,DIEN,FIND,FINDFVPL,IEN,NAME,NUM,TEMP,TYPE
  1.  D BLDRLIST^PXRMVPTR(801.41,15,.FINDFVPL)
  1.  D BLDRLIST^PXRMVPTR(801.4118,.01,.ADDFVPL)
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S ^TMP("PXRMXMZ",$J,1,0)="Dialog pre-conversion report:"
  1.  F TYPE="ICD9(","ICPT(","PXD(811.2," D
  1.  .S IEN=0 F  S IEN=$O(^TMP($J,"DLG FIND",TYPE,IEN)) Q:IEN'>0  D
  1.  ..S DIEN=0 F  S DIEN=$O(^TMP($J,"DLG FIND",TYPE,IEN,DIEN)) Q:DIEN'>0  D
  1.  ...S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  ...;If field is set assume conversion has already happen.
  1.  ...I TYPE="PXD(811.2,",$P($G(^PXRMD(801.41,DIEN,"TAX")),U)'="" Q
  1.  ...;If taxonomy is assigned as an additional finding assume conversion has already happen
  1.  ...I TYPE="PXD(811.2,",$D(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,18)) Q
  1.  ...I '$D(PXRMSKIP(NAME)) D BLDXTMP(TYPE,DIEN,IEN,.FINDFVPL,.ADDFVPL)
  1.  ...I TYPE="PXD(811.2," Q
  1.  ...;
  1.  ...F FIND=15,18 D
  1.  ....I FIND=15,$D(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,FIND)) S TEMP(15,DIEN)="" Q
  1.  ....S NUM=0 F  S NUM=$O(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,FIND,NUM)) Q:NUM'>0  S TEMP(18,DIEN,NUM)=""
  1.  I $D(^TMP($J,"DLG ORDER")) S DIEN=0 F  S DIEN=$O(^TMP($J,"DLG ORDER",DIEN)) Q:DIEN'>0  D BLDTXT(DIEN,.FINDFVPL,.ADDFVPL,0,1)
  1.  I '$D(TEMP) G BLDLISTX
  1.  F FIND=15,18 D
  1.  .S DIEN="" F  S DIEN=$O(TEMP(FIND,DIEN)) Q:DIEN'>0  D
  1.  ..I FIND=15 D DELDATA(DIEN,FIND) Q
  1.  ..S NUM="" F  S NUM=$O(TEMP(FIND,DIEN,NUM)) Q:NUM'>0  D DELDATA(DIEN,FIND,NUM)
  1. BLDLISTX ;
  1.  I $O(^TMP("PXRMXMZ",$J,""),-1)>1 D SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Patch 26 Pre-conversion dialog.")
  1.  K ^TMP("PXRMXMZ",$J)
  1.  Q
  1.  ;
  1. BLDTXT(DIEN,FINDFVPL,ADDFVPL,TAXNEEDS,PRE) ;
  1.  N ADD,CNT,CPTTEXT,NAME,NODE,NUM,POVTEXT,RES,TEXT,TEMP,TSEL
  1.  S CNT=+$O(^TMP("PXRMXMZ",$J,""),-1)
  1.  I CNT>0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1.  S NODE=$G(^PXRMD(801.41,DIEN,0))
  1.  S NAME=$P(NODE,U)
  1.  S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=NAME
  1.  S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="======================================================="
  1.  ;
  1.  S TEMP=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
  1.  ;S TEMP=$P($G(^PXRMD(801.41,DIEN,1)),U,5),RES=+$P($G(^PXRMD(801.41,DIEN,1)),U,3)
  1.  I TAXNEEDS=1 D
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="PREVIOUSLY THE DIALOG WAS SET TO BOTH CURRENT AND HISTORICAL ENCOUNTERS."
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="DIALOG IS NOW SET TO CURRENT ENCOUNTER ONLY."
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="REVIEW THE DIALOG BEFORE USING IN CPRS."
  1.  S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Resolution Type:",25)_" "_$$GET1^DIQ(801.41,DIEN,13)
  1.  I TEMP'="" D
  1.  .S TEXT=$$BLDTXTF(TEMP,.FINDFVPL)
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Finding Item:",25)_" "_TEXT
  1.  .D LISTCODE(DIEN,TEXT,TEMP,.CNT,0)
  1.  .S TSEL=$$GET1^DIQ(801.41,DIEN,123)
  1.  .I PRE=0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Taxonomy Pick List:",25)_" "_$G(TSEL)
  1.  .S CPTTEXT="",POVTEXT=""
  1.  .I "AD"[TSEL S POVTEXT=$$GET1^DIQ(801.41,DIEN,141)
  1.  .I "AP"[TSEL S CPTTEXT=$$GET1^DIQ(801.41,DIEN,142)
  1.  .I $G(POVTEXT)'="" S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Diagnosis Header:",25)_" "_POVTEXT
  1.  .I $G(CPTTEXT)'="" S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Procedure Header:",25)_" "_CPTTEXT
  1.  ;
  1.  I $D(^PXRMD(801.41,DIEN,3,0)) D
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Additional Finding Items:",25)
  1.  .S ADD="" F  S ADD=$O(^PXRMD(801.41,DIEN,3,"B",ADD)) Q:ADD=""  D
  1.  ..S TEXT=$$BLDTXTF(ADD,.ADDFVPL)
  1.  ..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="    Items: "_TEXT
  1.  ..D LISTCODE(DIEN,TEXT,ADD,.CNT,1)
  1.  I $P($G(^PXRMD(801.41,DIEN,2)),U,5)=1 D
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="Suppress All Prompts: Yes"
  1.  I $D(^PXRMD(801.41,DIEN,10)) D
  1.  . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1.  . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Components:",15)
  1.  . S NUM=0 F  S NUM=$O(^PXRMD(801.41,DIEN,10,NUM)) Q:NUM'>0  D
  1.  . .S NODE=$G(^PXRMD(801.41,DIEN,10,NUM,0))
  1.  . .D BLDTXTP(NODE,.CNT)
  1.  Q
  1.  ;
  1. BLDTXTP(NODE,CNT) ;
  1.  N DNODE,IEN,LABEL,NAME,TEMP,TYPE,TYPEOUT,VALUE,X
  1.  S IEN=$P(NODE,U,2) I +$G(IEN)'>0 Q
  1.  S DNODE=$G(^PXRMD(801.41,IEN,0))
  1.  S NAME=$P(DNODE,U),TYPE=$P(DNODE,U,4),TYPEOUT=$$BLDTXTT(TYPE)
  1.  S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Sequence:",20)_" "_$P(NODE,U)_" "_TYPEOUT_" "_NAME
  1.  I "FP"'[TYPE Q
  1.  F X=6:1:10 D
  1.  . S TEMP=$P(NODE,U,X) I TEMP="" Q
  1.  . S LABEL=$S(X=6:"Prompt Caption:",X=7:"New Line:",X=8:"Exclude From PN Text:",X=9:"Required:",1:" ")
  1.  . I $L(TEMP)>1 S VALUE=TEMP
  1.  . I $L(TEMP)=1 S VALUE=$S(TEMP=1:"Yes",1:"No")
  1.  . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR(LABEL,20)_" "_VALUE
  1.  Q
  1.  ;
  1. BLDTXTT(T) ;
  1.  N RESULT
  1.  S RESULT=$S(T="E":"Element",T="G":"Group",T="P":"Prompt",T="F":"Forced Value",T="S":"Result Group",T="T":"Result Element","R":"Dialog",1:"")
  1.  Q RESULT
  1.  ;
  1. BLDTXTF(FIND,FVPL) ;
  1.  N ABB,FNUM,GBL,IEN,NODE
  1.  S IEN=$P(FIND,";"),GBL=$P(FIND,";",2) I IEN'>0!(GBL="") Q ""
  1.  S NODE=$G(FVPL(GBL)) I NODE="" Q ""
  1.  S ABB=$P(NODE,U,4),FNUM=$P(NODE,U)
  1.  S FNAME=$$GET1^DIQ(FNUM,IEN,.01)
  1.  Q ABB_"."_FNAME
  1.  ;
  1. BLDXTMP(TYPE,DIEN,IEN,FINDVPL,ADDFVPL) ;
  1.  I TYPE="PXD(811.2," D  G PRETEXT
  1.  . S ^XTMP(PXRMXTMP,"DIALOG",DIEN)=""
  1.  . S ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=+$S($P($G(^PXRMD(801.41,DIEN,2)),U,5)="Y":0,1:1)
  1.  ;
  1.  S ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=""
  1. PRETEXT ;
  1.  S ^TMP($J,"DLG ORDER",DIEN)=""
  1.  S ^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE")=0
  1.  ;D BLDTXT(DIEN,.FINDVPL,.ADDFVPL,0,1)
  1.  Q
  1.  ;
  1. DELDATA(DIEN,FIELD,NUM) ;
  1.  N DA,DIE,DR
  1.  S DIE="^PXRMD(801.41,"
  1.  I FIELD=15 S DA=DIEN,DR="15///@"
  1.  I FIELD=18 D
  1.  .S DA(1)=DIEN,DA=NUM
  1.  .S DIE=DIE_DA(1)_",3,",DR=".01///@"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. LISTCODE(DIEN,TEXT,FIND,CNT,ISADD) ;
  1.  I $P(TEXT,".")'="TX" Q
  1.  N CODES,HIST,NLINES,NODE,TDX,TPR
  1.  S NODE="PXRM POST TEXT"
  1.  K ^TMP(NODE,$J)
  1.  S NLINES=0
  1.  D TAXDISP^PXRMDTAX(FIND,0,DIEN,.NLINES,NODE,ISADD,1)
  1.  S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=""
  1.  S NLINES=0 F  S NLINES=$O(^TMP(NODE,$J,NLINES)) Q:NLINES'>0  D
  1.  .S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=^TMP(NODE,$J,NLINES,0)
  1.  K ^TMP(NODE,$J)
  1.  Q
  1.  ;
  1.  ;
  1. TEST(DIEN,FIND) ;
  1.  N CNT,TEXT
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S CNT=0,TEXT="TX.SOMETHING"
  1.  D LISTCODE(DIEN,TEXT,FIND,.CNT,0)
  1.  S CNT=0 F  S CNT=$O(^TMP("PXRMXMZ",$J,CNT)) Q:CNT'>0  D
  1.  .W !,$G(^TMP("PXRMXMZ",$J,CNT,0))
  1.  Q