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