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

PXRMCSD.m

Go to the documentation of this file. 
  1. PXRMCSD ;SLC/JVS - Code Set Version-dialog file ;07/29/2010
  1.  ;;2.0;CLINICAL REMINDERS;**9,17,18**;Feb 04, 2005;Build 152
  1.  ;Variable List
  1.  ;TMP        =Mail message array
  1.  ;DLGNAME    =Dialogue Name .01 field
  1.  ;EFFDATE    =Effective Date
  1.  ;FILE       =Name of the Glpbal (ie ICPT or ICD9)
  1.  ;VAR,VAR3   =Variable Pointer
  1.  ;VARIEN     =Ien from Variable Pointer
  1.  ;VRSTATUS   =Status of Code in form 1 or 0
  1.  ;VARDESC    =Code Text Description
  1.  ;STATUS     =External form of Code Status
  1.  ;NUM        =Line Number
  1.  ;
  1.  Q
  1. TASKALL ;TASK for all codes
  1.  S ZTRTN="DLG^PXRMCSD(""ALL"")"
  1.  S ZTDESC="Finding Inactive Codes in Dialog file"
  1.  S ZTIO=""
  1.  S ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  Q
  1. TASKCPT ;TASK for Icpt codes Diagnosis
  1.  S ZTRTN="DLG^PXRMCSD(""ICPT"")"
  1.  S ZTDESC="Finding Inactive Codes in Dialog file"
  1.  S ZTIO=""
  1.  S ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  Q
  1. TASKICD ;TASK for ICD codes
  1.  S ZTRTN="DLG^PXRMCSD(""ICD9"")"
  1.  S ZTDESC="Finding Inactive Codes in Dialog file"
  1.  S ZTIO=""
  1.  S ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  Q
  1. OPTION ;Option entry point for dir call
  1.  N X,Y,%,%H,X
  1.  K DIR,Y,%I
  1.  S DIR(0)="SX^1:ICPT Codes;2:ICD9 Codes;3:ALL Codes"
  1.  S DIR("A")="Select Codes or All of the codes or ""^"" to exit"
  1.  S DIR("?",1)="This option is use to evaluate the various codes"
  1.  S DIR("?",2)="used in the reminder dialogs as Finding Items and"
  1.  S DIR("?",3)="Additonal Finding Items. It will report by mail message"
  1.  S DIR("?",4)="which codes are now inactive or are set to become"
  1.  S DIR("?",5)="in the future."
  1.  S DIR("B")="3"
  1.  S DIR("?")="Select a code set to be evaluated"
  1.  D ^DIR
  1.  I Y=1 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ICPT"",1)"
  1.  I Y=2 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ICD9"",1)"
  1.  I Y=3 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ALL"",1)"
  1.  S ZTDESC="Finding Inactive Codes in Dialog file"
  1.  S ZTIO=""
  1.  D NOW^%DTC S ZTDTH=%H
  1.  D ^%ZTLOAD
  1.  K DIR,Y,%I,X
  1.  Q
  1.  ;
  1. DLG(GLOBAL,OPTION) ;ENTRY POINT
  1.  ;Test entry point to $O through dialogues
  1.  ;GLOBAL = Which code set to check out.
  1.  ;GLOBAL ="ICPT" OR "ICD9" OR "ALL"
  1.  ;OPTION = From and option 1=yes null=no
  1.  ;^PXRMD(801.41,IEN,1) 5TH PIECE
  1.  Q:'$D(GLOBAL)
  1.  N IEN,VAR,STATUS,NUM,ITEM,FILE,VARDIS,LINE,VARTYP
  1.  N VARIEN,VRSTATUS,VARDESC,DLGNAME,VARIENX,ARRY,VARDIS
  1.  N TMP,TYPE,XMDUN,XMSUB,XMUSB
  1.  ;=====Set variables====================================
  1.  S TMP="^TMP(""PXRMXMZ"",$J,NUM,0)"
  1.  S NUM=0
  1.  S LINE="S NUM=NUM+1"
  1.  D TEXT
  1.  S IEN=0 F  S IEN=$O(^PXRMD(801.41,IEN)) Q:IEN'>0  D
  1.  .S VAR=$P($G(^PXRMD(801.41,IEN,1)),"^",5) ;varable pointer
  1.  .S DLGNAME=$P($G(^PXRMD(801.41,IEN,0)),"^",1)
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),"^",4)
  1.  .I +VAR'=0 S ITEM=" FI" D
  1.  ..;============ICPT(=================================
  1.  ..N VARIEN,CPTDATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
  1.  ..I $P(VAR,";",2)="ICPT(",((GLOBAL="ICPT")!(GLOBAL="ALL")) D
  1.  ...S FILE=" CPT"
  1.  ...S VARIEN=$P(VAR,";",1) ;Ien from variable pointer
  1.  ...S CPTDATA=$$CPTA^PXRMCSU(VARIEN) ;ALL Cpt data
  1.  ...I ($P(CPTDATA,"^",7)=0) D
  1.  ....S IADATE=$$CONV^PXRMCSU($P(CPTDATA,"^",8)) ;Convert Inactive date
  1.  ....S VARCODE=$$CPT^PXRMCSU(VARIEN) ;Code value
  1.  ....S VARDESC=$$CPTD^PXRMCSU(VARIEN) ;Description
  1.  ....S VARPAST=$P(CPTDATA,"^",11)
  1.  ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
  1.  .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
  1.  .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element disabled
  1.  ....D TMP
  1.  ..;============ICD9(=================================
  1.  ..N VARIEN,ICD9DATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
  1.  ..I $P(VAR,";",2)="ICD9(",((GLOBAL="ICD9")!(GLOBAL="ALL")) D
  1.  ...S FILE="ICD9"
  1.  ...S VARIEN=$P(VAR,";",1) ;Ien from variable pointer
  1.  ...S ICD9DATA=$$ICD9A^PXRMCSU(VARIEN) ;All ICD9 data
  1.  ...I ($P(ICD9DATA,"^",10)=0) D
  1.  ....S IADATE=$$CONV^PXRMCSU($P(ICD9DATA,"^",12)) ;Conver Inact date
  1.  ....S VARCODE=$$ICD9^PXRMCSU(VARIEN) ;Code
  1.  ....S VARDESC=$$ICD9D^PXRMCSU(VARIEN) ;Description
  1.  ....S VARPAST=$P(ICD9DATA,"^",19)
  1.  ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
  1.  .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
  1.  .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element description
  1.  ....D TMP
  1.  .D DLG3
  1.  S XMSUB="Reminder Dialog "_$S(GLOBAL="ALL":"ICD9 AND CPT",GLOBAL="ICPT":"CPT",1:GLOBAL)_" Code changes"
  1.  I '$D(^TMP("PXRMXMZ",$J)) D
  1.  . S ^TMP("PXRMXMZ",$J,1,0)="No dialog elements using inactive codes were found."
  1.  . S ^TMP("PXRMXMZ",$J,2,0)="No action is necessary."
  1.  D SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S ZTREQ="@"
  1.  Q
  1. DLG3 ;^PXRMD(801.41,IEN,3,IEN3,0) 1ST PIECE
  1.  N IEN3,VAR3
  1.  S IEN3=0 F  S IEN3=$O(^PXRMD(801.41,IEN,3,IEN3)) Q:IEN3'>0  D
  1.  .S VAR3=$P($G(^PXRMD(801.41,IEN,3,IEN3,0)),"^",1)
  1.  .I +VAR3'=0 S ITEM="AFI" D
  1.  ..;================ICPT================================= 
  1.  ..N VARIEN,CPTDATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
  1.  ..I $P(VAR3,";",2)="ICPT(",((GLOBAL="ICPT")!(GLOBAL="ALL")) D
  1.  ...S FILE=" CPT"
  1.  ...S VARIEN=$P(VAR3,";",1) ;Ien from variable pointer
  1.  ...S CPTDATA=$$CPTA^PXRMCSU(VARIEN) ;All CPT data
  1.  ...I ($P(CPTDATA,"^",7)=0) D
  1.  ....S IADATE=$$CONV^PXRMCSU($P(CPTDATA,"^",8)) ;Convert Inac Date
  1.  ....S VARCODE=$$CPT^PXRMCSU(VARIEN) ;Code
  1.  ....S VARDESC=$$CPTD^PXRMCSU(VARIEN) ;Description
  1.  ....S VARPAST=$P(CPTDATA,"^",11)
  1.  ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
  1.  .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
  1.  .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element description
  1.  ....D TMP
  1.  ..;================ICD9=================================
  1.  ..N VARIEN,ICD9DATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
  1.  ..I $P(VAR3,";",2)="ICD9(",((GLOBAL="ICD9")!(GLOBAL="ALL")) D
  1.  ...S FILE="ICD9"
  1.  ...S VARIEN=$P(VAR3,";",1) ;Ien from variable pointer
  1.  ...S ICD9DATA=$$ICD9A^PXRMCSU(VARIEN) ;All ICD9 data
  1.  ...I ($P(ICD9DATA,"^",10)=0) D
  1.  ....S IADATE=$$CONV^PXRMCSU($P(ICD9DATA,"^",12)) ;Conver Inac date
  1.  ....S VARCODE=$$ICD9^PXRMCSU(VARIEN) ;Code
  1.  ....S VARDESC=$$ICD9D^PXRMCSU(VARIEN) ;Description
  1.  ....S VARPAST=$P(ICD9DATA,"^",19)
  1.  ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
  1.  .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
  1.  .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element desc
  1.  ....D TMP
  1.  Q
  1. SUB ;==============Sub Routines=============================
  1.  ;SET MAIL MESSAGE LINE
  1. TMP ;Set tmp global lines
  1.  X LINE S @TMP="    "_FILE_" "_ITEM_": "_VARCODE_" (Inactive "_$G(IADATE)_")"
  1.  S VARDIS=$S($G(VARDIS)'="":"(Disabled)",1:"(Enabled)")
  1.  S VARTYP=$G(VARTYP)
  1.  X LINE S @TMP="    Found in: "_DLGNAME_" ["_VARTYP_"]"_" "_VARDIS
  1.  D PARENT(IEN)
  1.  Q
  1. MESS ;Mail Message Static Text
  1.  Q
  1. MESS1 ;
  1.  N GLOBALX
  1.  S GLOBALX=$S(GLOBAL="ICPT":"CPT",GLOBAL="ICD9":"ICD9",GLOBAL="ALL":"CPT and/or ICD9",1:"")
  1.  I $G(OPTION)=1 S MESS1="Review of inactive codes as of "_$$CONV^PXRMCSU(DT)
  1.  I $G(OPTION)="" S MESS1="There was a "_GLOBALX_" code set update on "_$$CONV^PXRMCSU(DT)
  1.  Q
  1. MESS2 ;
  1.  ;;
  1.  ;;Please review the FINDING ITEM and ADDITIONAL FINDING items
  1.  ;;currently used by REMINDER DIALOGS that may need changes.
  1.  ;;
  1.  ;;Consider adding another ADDITIONAL FINDING item to the reminder dialog
  1.  ;;entry which will be active. This will allow the dialog to have old
  1.  ;;and new codes associated with a dialog element, which will use
  1.  ;;the item that is active for the encounter date.
  1.  ;;Eventually, the inactive FINDING ITEM or ADDITIONAL FINDING items
  1.  ;;should be removed from the dialog element.
  1.  ;;
  1.  ;;Note: FI=FINDING ITEM field    AFI=ADDITIONAL FINDING ITEMS field
  1.  ;;Note: [finding type]  (status)
  1.  ;;_______________________________________________________________________________
  1.  Q
  1. MESS3 ;
  1.  ;;Report of Inactive ICD9 and CPT Codes referenced in the Reminder
  1.  ;;Dialog file.
  1.  ;;
  1.  ;;Note: FI=FINDING ITEM field    AFI=ADDITIONAL FINDING ITEMS field
  1.  ;;Note: [finding type]  (status)
  1.  ;;_______________________________________________________________________________
  1.  Q
  1. TEXT ;display text
  1.  N MESS1,PXRMI
  1.  I GLOBAL="ALL" D
  1.  .F PXRMI=1:1:6 X LINE S @TMP=$P($T(MESS3+PXRMI),";",3)
  1.  I GLOBAL'="ALL" D
  1.  .D MESS1 X LINE S @TMP=MESS1
  1.  .F PXRMI=1:1:14 D
  1.  ..X LINE S @TMP=$P($T(MESS2+PXRMI),";",3)
  1.  Q
  1. PARENT(PARXY) ;Get the Parent Dialog Element of the Dialog Element
  1.  N PARY,PARXYVAR,PARX,PXRMTYPE
  1.  S PARX=0 F  S PARX=$O(^PXRMD(801.41,PARX)) Q:PARX<1  D
  1.  .S PARY=0 F  S PARY=$O(^PXRMD(801.41,PARX,10,"D",PARY)) Q:PARY<1  D 
  1.  ..I PARXY=PARY D GETS^DIQ(801.41,PARX,"3;4","E","PXRMTYPE") D
  1.  ...S PARXYVAR=PARX_",",VARDIS=$G(PXRMTYPE(801.41,PARXYVAR,3,"E")),VARDIS=$S($G(VARDIS)'="":"(Disabled)",1:"(Enabled)")
  1.  ...X LINE S @TMP="     Used by: "_$P($G(^PXRMD(801.41,PARX,0)),"^",1)_" ["_$G(PXRMTYPE(801.41,PARXYVAR,4,"E"))_"]"_" "_VARDIS
  1.  X LINE S @TMP="___________________________________________________________________________"
  1.  Q