BEHOORSY ; IHS/MSC/MGH Sign or Symptom ;27-Oct-2015 10:28;PLS
;;1.1;BEH COMPONENTS;**011006,011007,011008**;Sep 18, 2007;Build 1
;
;
GETDIAG ; EP
; User MUST enter a diagnosis. No exceptions.
N DIR,SNOMED,IN,OUT,ITEM,DA,SNO,XSAVE,LINE,LINEVAR,NUM,ICDCODE
N SNOMED,SNOMEDSC,VARS,VARSDESC,WHICHONE
;S Y=0
;F Q:Y D
;. W !!
;. D ^XBFMK
;. S DIR(0)="F"
;. S DIR("A")="Enter Clinical Indication (Free Text)"
;. D ^DIR
;. I $L(X)<1!(+$G(DIRUT))!(X["^") S Y=9999999 Q
S XSAVE=X
K OUT S OUT="VARS",IN=$G(X)_"^F",$P(IN,"^",6)=100,$P(IN,"^",8)=1,$P(IN,"^",11)=1
S SNO=$$SEARCH^BSTSAPI(OUT,IN)
I SNO<1 W !!,?9,"No entries found in the IHS STANDARD TERMINOLOGY database."
I SNO>0&(SNO'=9999999) D
.S SNOMED=$$LISTMSEL()
.S Y=$P(SNOMED,U,1)
.S X=$P(SNOMED,U,1)
Q
POST(Y) ; Set the dialogs
N SNO
S SNO=$$DESC^BSTSAPI(Y)
S ORDIALOG($$PTR("CLININD"),1)=$P(SNO,U,2)
S ORDIALOG($$PTR("SNMDCNPTID"),1)=$P(SNO,U,1)
S ORDIALOG($$PTR("CLININD2"),1)=$P($P(SNO,U,3),";")
Q
CHKDEL(Y) ;EP Check for deletion
I +Y=0 S ORDIALOG($$PTR("SNMDCNPTID"),1)=""
Q
;
PTR(X) ; -- Ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
LISTMSEL() ; EP - LIST Manager to SELect entry
K SNOMED
S WHICHONE=0
D EN^BEHOORSM(1)
Q $G(SNOMED(WHICHONE))
QUIT ; EP -
;
D CLEAR^VALM1
K SNOMED,DA
Q
CHK() ;EP -See what its doing
I $G(ORDIALOG($$PTR("CLININD"),1))="" D
.S ORDIALOG($$PTR("SNMDCNPTID"),1)=""
Q
ID() ;Set CLININD2
N CLIN,ID
S CLIND=$$PTR("CLININD2")
S ID=$G(ORDIALOG(CLIND,1))
Q ID
QUICK ;Report to find quick orders with clinical indications that are not converted to SNOMED
N ZTRTN
W @IOF
W !,"Unconverted Quick Order to SNOMED clinical indication report",!!
S ZTRTN="OUT^BEHOORSY"
D DEVICE
Q
DEVICE ; Device handling
; Call with: ZTRTN
N %ZIS
S %ZIS="Q" D ^%ZIS Q:POP
G:$D(IO("Q")) QUE
NOQUE ; Call report directly
D @ZTRTN
Q
QUE ; Queue output
N %,ZTDTH,ZTIO,ZTSAVE,ZTSK
Q:'$D(ZTRTN)
K IO("Q") S ZTSAVE("BGORPT")=""
S:'$D(ZTDESC) ZTDESC="Unconverted Clinical Indication to SNOMED report" S ZTIO=ION
D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
D HOME^%ZIS
Q
OUT ;Run the report
N I,J,NAME,TYPE,ITEM,CVALUE,SVALUE,CLININD,SNOMED,NAME
D HDR
S (CLININD,SNOMED)=""
S CLININD=$O(^ORD(101.41,"B","OR GTX CLININD",""))
S SNOMED=$O(^ORD(101.41,"B","OR GTX SNMDCNPTID",""))
S I=0 F S I=$O(^ORD(101.41,I)) Q:'+I D
.S TYPE=$P($G(^ORD(101.41,I,0)),U,4)
.Q:TYPE'="Q"
.S (CVALUE,SVALUE)=""
.S J=0 F S J=$O(^ORD(101.41,I,6,J)) Q:'+J D
..S ITEM=$P($G(^ORD(101.41,I,6,J,0)),U,2)
..I ITEM=CLININD D
...S CVALUE=$G(^ORD(101.41,I,6,J,1))
..I ITEM=SNOMED D
...S SVALUE=$G(^ORD(101.41,I,6,J,1))
.I CVALUE'=""&(SVALUE="") D
..S NAME=$P($G(^ORD(101.41,I,0)),U,1)
..W !,NAME,?40,CVALUE
Q
HDR(TYP) ;PRINT HEADER
N LIN,DTYP
I IOST["C-" W @IOF
W !,"Unconverted Clinical Indication to SNOMED report",!
W !,"Order Dialog",?40,"Clinical Indication"
W ! F LIN=1:1:72 W "-"
W !
Q
BEHOORSY ; IHS/MSC/MGH Sign or Symptom ;27-Oct-2015 10:28;PLS
+1 ;;1.1;BEH COMPONENTS;**011006,011007,011008**;Sep 18, 2007;Build 1
+2 ;
+3 ;
GETDIAG ; EP
+1 ; User MUST enter a diagnosis. No exceptions.
+2 NEW DIR,SNOMED,IN,OUT,ITEM,DA,SNO,XSAVE,LINE,LINEVAR,NUM,ICDCODE
+3 NEW SNOMED,SNOMEDSC,VARS,VARSDESC,WHICHONE
+4 ;S Y=0
+5 ;F Q:Y D
+6 ;. W !!
+7 ;. D ^XBFMK
+8 ;. S DIR(0)="F"
+9 ;. S DIR("A")="Enter Clinical Indication (Free Text)"
+10 ;. D ^DIR
+11 ;. I $L(X)<1!(+$G(DIRUT))!(X["^") S Y=9999999 Q
+12 SET XSAVE=X
+13 KILL OUT
SET OUT="VARS"
SET IN=$GET(X)_"^F"
SET $PIECE(IN,"^",6)=100
SET $PIECE(IN,"^",8)=1
SET $PIECE(IN,"^",11)=1
+14 SET SNO=$$SEARCH^BSTSAPI(OUT,IN)
+15 IF SNO<1
WRITE !!,?9,"No entries found in the IHS STANDARD TERMINOLOGY database."
+16 IF SNO>0&(SNO'=9999999)
Begin DoDot:1
+17 SET SNOMED=$$LISTMSEL()
+18 SET Y=$PIECE(SNOMED,U,1)
+19 SET X=$PIECE(SNOMED,U,1)
End DoDot:1
+20 QUIT
POST(Y) ; Set the dialogs
+1 NEW SNO
+2 SET SNO=$$DESC^BSTSAPI(Y)
+3 SET ORDIALOG($$PTR("CLININD"),1)=$PIECE(SNO,U,2)
+4 SET ORDIALOG($$PTR("SNMDCNPTID"),1)=$PIECE(SNO,U,1)
+5 SET ORDIALOG($$PTR("CLININD2"),1)=$PIECE($PIECE(SNO,U,3),";")
+6 QUIT
CHKDEL(Y) ;EP Check for deletion
+1 IF +Y=0
SET ORDIALOG($$PTR("SNMDCNPTID"),1)=""
+2 QUIT
+3 ;
PTR(X) ; -- Ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
LISTMSEL() ; EP - LIST Manager to SELect entry
+1 KILL SNOMED
+2 SET WHICHONE=0
+3 DO EN^BEHOORSM(1)
+4 QUIT $GET(SNOMED(WHICHONE))
QUIT ; EP -
+1 ;
+2 DO CLEAR^VALM1
+3 KILL SNOMED,DA
+4 QUIT
CHK() ;EP -See what its doing
+1 IF $GET(ORDIALOG($$PTR("CLININD"),1))=""
Begin DoDot:1
+2 SET ORDIALOG($$PTR("SNMDCNPTID"),1)=""
End DoDot:1
+3 QUIT
ID() ;Set CLININD2
+1 NEW CLIN,ID
+2 SET CLIND=$$PTR("CLININD2")
+3 SET ID=$GET(ORDIALOG(CLIND,1))
+4 QUIT ID
QUICK ;Report to find quick orders with clinical indications that are not converted to SNOMED
+1 NEW ZTRTN
+2 WRITE @IOF
+3 WRITE !,"Unconverted Quick Order to SNOMED clinical indication report",!!
+4 SET ZTRTN="OUT^BEHOORSY"
+5 DO DEVICE
+6 QUIT
DEVICE ; Device handling
+1 ; Call with: ZTRTN
+2 NEW %ZIS
+3 SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+4 IF $DATA(IO("Q"))
GOTO QUE
NOQUE ; Call report directly
+1 DO @ZTRTN
+2 QUIT
QUE ; Queue output
+1 NEW %,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 IF '$DATA(ZTRTN)
QUIT
+3 KILL IO("Q")
SET ZTSAVE("BGORPT")=""
+4 IF '$DATA(ZTDESC)
SET ZTDESC="Unconverted Clinical Indication to SNOMED report"
SET ZTIO=ION
+5 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+6 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+7 DO HOME^%ZIS
+8 QUIT
OUT ;Run the report
+1 NEW I,J,NAME,TYPE,ITEM,CVALUE,SVALUE,CLININD,SNOMED,NAME
+2 DO HDR
+3 SET (CLININD,SNOMED)=""
+4 SET CLININD=$ORDER(^ORD(101.41,"B","OR GTX CLININD",""))
+5 SET SNOMED=$ORDER(^ORD(101.41,"B","OR GTX SNMDCNPTID",""))
+6 SET I=0
FOR
SET I=$ORDER(^ORD(101.41,I))
IF '+I
QUIT
Begin DoDot:1
+7 SET TYPE=$PIECE($GET(^ORD(101.41,I,0)),U,4)
+8 IF TYPE'="Q"
QUIT
+9 SET (CVALUE,SVALUE)=""
+10 SET J=0
FOR
SET J=$ORDER(^ORD(101.41,I,6,J))
IF '+J
QUIT
Begin DoDot:2
+11 SET ITEM=$PIECE($GET(^ORD(101.41,I,6,J,0)),U,2)
+12 IF ITEM=CLININD
Begin DoDot:3
+13 SET CVALUE=$GET(^ORD(101.41,I,6,J,1))
End DoDot:3
+14 IF ITEM=SNOMED
Begin DoDot:3
+15 SET SVALUE=$GET(^ORD(101.41,I,6,J,1))
End DoDot:3
End DoDot:2
+16 IF CVALUE'=""&(SVALUE="")
Begin DoDot:2
+17 SET NAME=$PIECE($GET(^ORD(101.41,I,0)),U,1)
+18 WRITE !,NAME,?40,CVALUE
End DoDot:2
End DoDot:1
+19 QUIT
HDR(TYP) ;PRINT HEADER
+1 NEW LIN,DTYP
+2 IF IOST["C-"
WRITE @IOF
+3 WRITE !,"Unconverted Clinical Indication to SNOMED report",!
+4 WRITE !,"Order Dialog",?40,"Clinical Indication"
+5 WRITE !
FOR LIN=1:1:72
WRITE "-"
+6 WRITE !
+7 QUIT
