BTIULO12 ;IHS/MSC/MGH - IHS OBJECTS ADDED IN PATCHES ;06-Jan-2016 12:29;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1006,1009,1010,1012,1016**;NOV 04, 2004;Build 10
TORDER(DFN,TARGET) ;EP Orders for today
NEW X,I,CNT,RESULT
S CNT=0
D GETORD(.RESULT,DFN)
K @TARGET
S I=0 F S I=$O(RESULT(I)) Q:'I D
.I $G(RESULT(I))'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Orders."
Q "~@"_$NA(@TARGET)
GETORD(RETURN,DFN) ;Get list of orders
K RETURN
NEW VDT,END,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,ORDER,OLDOR,NEWORD
S C=0,OLDOR=0
K ^TMP("ORR",$J)
;Get all orders for today
S VDT=DT,END=VDT_".2359"
I '$L($T(EN^ORQ1)) Q
D EN^ORQ1(DFN_";DPT(",1,2,"",VDT,END,1)
I '$D(ORLIST) S RETURN(1)="" Q
F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X K ORD M ORD=^(X) D
. S Y=$P($G(^OR(100,+ORD,0)),U,10)
. I $P(ORD,U,7)="canc" Q
. S ORDER=+ORD
. Q:ORDER=OLDOR
. S OLDOR=ORDER
. S C=C+1
. F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y D
.. I $E(ORD("TX",Y),1)="<" Q
.. ;I $E(ORD("TX",Y),1,6)="Change" Q
.. I $E(ORD("TX",Y),1,6)="Change" S ORD("TX",Y)=$E(ORD("TX",Y),8,999)
.. ;I $E(ORD("TX",Y),1,3)="to " Q
.. I $E(ORD("TX",Y),1,3)="to " D
... K RETURN(C)
... S NEWORD=$E(ORD("TX",Y),4,999)
... S RETURN(C)=" "_NEWORD
.. E S RETURN(C)=$G(RETURN(C))_" "_$P(ORD("TX",Y)," Quantity:")
I C=0 S RETURN(1)=""
K ^TMP("ORR",$J)
Q
ORDTYPE(DFN,TARGET,TYPE) ;EP Orders for today depending on the type
NEW X,I,CNT,RESULT
S CNT=0
D GETORD2(.RESULT,DFN,TYPE)
K @TARGET
S I=0 F S I=$O(RESULT(I)) Q:'I D
.I $G(RESULT(I))'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Orders."
Q "~@"_$NA(@TARGET)
GETORD2(RETURN,DFN,TYPE) ;Get list of orders
K RETURN
NEW VDT,END,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,ORACT,ACT,NATURE,CODE
S C=0
K ^TMP("ORR",$J)
;Get all orders for today
S VDT=DT,END=VDT_".2359"
I '$L($T(EN^ORQ1)) Q
D EN^ORQ1(DFN_";DPT(",1,2,"",VDT,END,1)
I '$D(ORLIST) S RETURN(1)="" Q
F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X K ORD M ORD=^(X) D
. S CODE=""
. S Y=$P($G(^OR(100,+ORD,0)),U,10)
. I $P(ORD,U,7)="canc" Q
. S ORACT=$P($P(ORD,U,1),";",2)
. S ACT=$G(^OR(100,+ORD,8,ORACT,0))
. S NATURE=$P(ACT,U,12)
. I NATURE'="" S CODE=$P($G(^ORD(100.02,NATURE,0)),U,2)
. Q:CODE'=TYPE
.F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y D
.. I $E(ORD("TX",Y),1)="<" Q
.. I $E(ORD("TX",Y),1,6)="Change" Q
.. I $E(ORD("TX",Y),1,3)="to " S ORD("TX",Y)=$E(ORD("TX",Y),4,999) ;I
.. S C=C+1
.. S RETURN(C)=$G(RETURN(C))_" "_$P(ORD("TX",Y)," Quantity:")
I C=0 S RETURN(1)=""
K ^TMP("ORR",$J)
Q
PRELAN(DFN) ;Preferred language
N PRILAN,PRETER,PREFLAN,PROF,LANDT,IEN
S PREFLAN="Not recorded"
S LANDT=9999999 S LANDT=$O(^AUPNPAT(DFN,86,LANDT),-1)
Q:LANDT="" PREFLAN
S IEN=LANDT_","_DFN
S PREFLAN=$$GET1^DIQ(9000001.86,IEN,.04)
Q PREFLAN
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
;IHS/MSC/MGH Added patch 1010
PHN(DFN,TARGET,NUM) ;Return PHN data
N CNT,CT,VDT,PHN,VPHN,FNUM,LONG,LVL,NSG,PSYCH,REC,SHORT,VDATE
S CT=0,CNT=0,PHN=""
S NUM=NUM-1
I NUM="" S NUM=1
S FNUM=9000010.32
F S PHN=$O(^AUPNVPHN("AA",DFN,PHN)) Q:PHN="" D
.S VDT=0
.F S VDT=$O(^AUPNVPHN("AA",DFN,PHN,VDT)) Q:'VDT D
..S VPHN=""
..F S VPHN=$O(^AUPNVPHN("AA",DFN,PHN,VDT,VPHN)) Q:'VPHN!(CNT>NUM) D
...S REC=$G(^AUPNVPHN(VPHN,0))
...S CNT=CNT+1
...S LVL=$$GET1^DIQ(FNUM,VPHN,.05)
...S TYPE=$$GET1^DIQ(FNUM,VPHN,.06)
...S PSYCH=$G(^AUPNVPHN(VPHN,21))
...S NSG=$G(^AUPNVPHN(VPHN,22))
...S SHORT=$G(^AUPNVPHN(VPHN,23))
...S LONG=$G(^AUPNVPHN(VPHN,24))
...S VDATE=9999999-VDT
...S VDATE=$$FMTDATE^BGOUTL(VDATE)
...I CNT>1 D
....S CT=CT+1
....S @TARGET@(CT,0)=""
...S CT=CT+1
...S @TARGET@(CT,0)="Visit Date: "_VDATE
...I LVL'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Level of Intervention: "_LVL
...I TYPE'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Type of Decision Making: "_TYPE
...I PSYCH'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Psycho/Social/Envron: "_PSYCH
...I NSG'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Nursing DX: "_NSG
...I SHORT'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Short Term Goals: "_SHORT
...I LONG'="" D
....S CT=CT+1
....S @TARGET@(CT,0)="Long Term Goals: "_LONG
I CT=0 S @TARGET@(1,0)="No PHNs for this patient."
Q "~@"_$NA(@TARGET)
;New object for current PHN Patch 1016
VPHN(DFN,TARGET) ;Return PHN for the visit context patch 1016
N X,VST,VDT,CNT,RESULT,PHN,FNUM,LONG,LVL,NSG,PSYCH,REC,SHORT,VDATE
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
S CNT=0
S FNUM=9000010.32
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S PHN="" F S PHN=$O(^AUPNVPHN("AD",VST,PHN)) Q:PHN="" D
.S REC=$G(^AUPNVPHN(PHN,0))
.S LVL=$$GET1^DIQ(FNUM,PHN,.05)
.S TYPE=$$GET1^DIQ(FNUM,PHN,.06)
.S PSYCH=$G(^AUPNVPHN(PHN,21))
.S NSG=$G(^AUPNVPHN(PHN,22))
.S SHORT=$G(^AUPNVPHN(PHN,23))
.S LONG=$G(^AUPNVPHN(PHN,24))
.S VDATE=$$GET1^DIQ(9000010.32,PHN,.03)
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Visit Date: "_VDATE
.I LVL'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Level of Intervention: "_LVL
.I TYPE'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Type of Decision Making: "_TYPE
.I PSYCH'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Psycho/Social/Envron: "_PSYCH
.I NSG'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Nursing DX: "_NSG
.I SHORT'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Short Term Goals: "_SHORT
.I LONG'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Long Term Goals: "_LONG
I CNT=0 S @TARGET@(1,0)="No PHN for this visit."
Q "~@"_$NA(@TARGET)
BTIULO12 ;IHS/MSC/MGH - IHS OBJECTS ADDED IN PATCHES ;06-Jan-2016 12:29;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1009,1010,1012,1016**;NOV 04, 2004;Build 10
TORDER(DFN,TARGET) ;EP Orders for today
+1 NEW X,I,CNT,RESULT
+2 SET CNT=0
+3 DO GETORD(.RESULT,DFN)
+4 KILL @TARGET
+5 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+6 IF $GET(RESULT(I))'=""
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:2
End DoDot:1
+9 IF 'CNT
SET @TARGET@(1,0)="No Orders."
+10 QUIT "~@"_$NAME(@TARGET)
GETORD(RETURN,DFN) ;Get list of orders
+1 KILL RETURN
+2 NEW VDT,END,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,ORDER,OLDOR,NEWORD
+3 SET C=0
SET OLDOR=0
+4 KILL ^TMP("ORR",$JOB)
+5 ;Get all orders for today
+6 SET VDT=DT
SET END=VDT_".2359"
+7 IF '$LENGTH($TEXT(EN^ORQ1))
QUIT
+8 DO EN^ORQ1(DFN_";DPT(",1,2,"",VDT,END,1)
+9 IF '$DATA(ORLIST)
SET RETURN(1)=""
QUIT
+10 FOR X=0:0
SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))
IF 'X
QUIT
KILL ORD
MERGE ORD=^(X)
Begin DoDot:1
+11 SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)
+12 IF $PIECE(ORD,U,7)="canc"
QUIT
+13 SET ORDER=+ORD
+14 IF ORDER=OLDOR
QUIT
+15 SET OLDOR=ORDER
+16 SET C=C+1
+17 FOR Y=0:0
SET Y=$ORDER(ORD("TX",Y))
IF 'Y
QUIT
Begin DoDot:2
+18 IF $EXTRACT(ORD("TX",Y),1)="<"
QUIT
+19 ;I $E(ORD("TX",Y),1,6)="Change" Q
+20 IF $EXTRACT(ORD("TX",Y),1,6)="Change"
SET ORD("TX",Y)=$EXTRACT(ORD("TX",Y),8,999)
+21 ;I $E(ORD("TX",Y),1,3)="to " Q
+22 IF $EXTRACT(ORD("TX",Y),1,3)="to "
Begin DoDot:3
+23 KILL RETURN(C)
+24 SET NEWORD=$EXTRACT(ORD("TX",Y),4,999)
+25 SET RETURN(C)=" "_NEWORD
End DoDot:3
+26 IF '$TEST
SET RETURN(C)=$GET(RETURN(C))_" "_$PIECE(ORD("TX",Y)," Quantity:")
End DoDot:2
End DoDot:1
+27 IF C=0
SET RETURN(1)=""
+28 KILL ^TMP("ORR",$JOB)
+29 QUIT
ORDTYPE(DFN,TARGET,TYPE) ;EP Orders for today depending on the type
+1 NEW X,I,CNT,RESULT
+2 SET CNT=0
+3 DO GETORD2(.RESULT,DFN,TYPE)
+4 KILL @TARGET
+5 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+6 IF $GET(RESULT(I))'=""
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:2
End DoDot:1
+9 IF 'CNT
SET @TARGET@(1,0)="No Orders."
+10 QUIT "~@"_$NAME(@TARGET)
GETORD2(RETURN,DFN,TYPE) ;Get list of orders
+1 KILL RETURN
+2 NEW VDT,END,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,ORACT,ACT,NATURE,CODE
+3 SET C=0
+4 KILL ^TMP("ORR",$JOB)
+5 ;Get all orders for today
+6 SET VDT=DT
SET END=VDT_".2359"
+7 IF '$LENGTH($TEXT(EN^ORQ1))
QUIT
+8 DO EN^ORQ1(DFN_";DPT(",1,2,"",VDT,END,1)
+9 IF '$DATA(ORLIST)
SET RETURN(1)=""
QUIT
+10 FOR X=0:0
SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))
IF 'X
QUIT
KILL ORD
MERGE ORD=^(X)
Begin DoDot:1
+11 SET CODE=""
+12 SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)
+13 IF $PIECE(ORD,U,7)="canc"
QUIT
+14 SET ORACT=$PIECE($PIECE(ORD,U,1),";",2)
+15 SET ACT=$GET(^OR(100,+ORD,8,ORACT,0))
+16 SET NATURE=$PIECE(ACT,U,12)
+17 IF NATURE'=""
SET CODE=$PIECE($GET(^ORD(100.02,NATURE,0)),U,2)
+18 IF CODE'=TYPE
QUIT
+19 FOR Y=0:0
SET Y=$ORDER(ORD("TX",Y))
IF 'Y
QUIT
Begin DoDot:2
+20 IF $EXTRACT(ORD("TX",Y),1)="<"
QUIT
+21 IF $EXTRACT(ORD("TX",Y),1,6)="Change"
QUIT
+22 ;I
IF $EXTRACT(ORD("TX",Y),1,3)="to "
SET ORD("TX",Y)=$EXTRACT(ORD("TX",Y),4,999)
+23 SET C=C+1
+24 SET RETURN(C)=$GET(RETURN(C))_" "_$PIECE(ORD("TX",Y)," Quantity:")
End DoDot:2
End DoDot:1
+25 IF C=0
SET RETURN(1)=""
+26 KILL ^TMP("ORR",$JOB)
+27 QUIT
PRELAN(DFN) ;Preferred language
+1 NEW PRILAN,PRETER,PREFLAN,PROF,LANDT,IEN
+2 SET PREFLAN="Not recorded"
+3 SET LANDT=9999999
SET LANDT=$ORDER(^AUPNPAT(DFN,86,LANDT),-1)
+4 IF LANDT=""
QUIT PREFLAN
+5 SET IEN=LANDT_","_DFN
+6 SET PREFLAN=$$GET1^DIQ(9000001.86,IEN,.04)
+7 QUIT PREFLAN
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
+2 ;IHS/MSC/MGH Added patch 1010
PHN(DFN,TARGET,NUM) ;Return PHN data
+1 NEW CNT,CT,VDT,PHN,VPHN,FNUM,LONG,LVL,NSG,PSYCH,REC,SHORT,VDATE
+2 SET CT=0
SET CNT=0
SET PHN=""
+3 SET NUM=NUM-1
+4 IF NUM=""
SET NUM=1
+5 SET FNUM=9000010.32
+6 FOR
SET PHN=$ORDER(^AUPNVPHN("AA",DFN,PHN))
IF PHN=""
QUIT
Begin DoDot:1
+7 SET VDT=0
+8 FOR
SET VDT=$ORDER(^AUPNVPHN("AA",DFN,PHN,VDT))
IF 'VDT
QUIT
Begin DoDot:2
+9 SET VPHN=""
+10 FOR
SET VPHN=$ORDER(^AUPNVPHN("AA",DFN,PHN,VDT,VPHN))
IF 'VPHN!(CNT>NUM)
QUIT
Begin DoDot:3
+11 SET REC=$GET(^AUPNVPHN(VPHN,0))
+12 SET CNT=CNT+1
+13 SET LVL=$$GET1^DIQ(FNUM,VPHN,.05)
+14 SET TYPE=$$GET1^DIQ(FNUM,VPHN,.06)
+15 SET PSYCH=$GET(^AUPNVPHN(VPHN,21))
+16 SET NSG=$GET(^AUPNVPHN(VPHN,22))
+17 SET SHORT=$GET(^AUPNVPHN(VPHN,23))
+18 SET LONG=$GET(^AUPNVPHN(VPHN,24))
+19 SET VDATE=9999999-VDT
+20 SET VDATE=$$FMTDATE^BGOUTL(VDATE)
+21 IF CNT>1
Begin DoDot:4
+22 SET CT=CT+1
+23 SET @TARGET@(CT,0)=""
End DoDot:4
+24 SET CT=CT+1
+25 SET @TARGET@(CT,0)="Visit Date: "_VDATE
+26 IF LVL'=""
Begin DoDot:4
+27 SET CT=CT+1
+28 SET @TARGET@(CT,0)="Level of Intervention: "_LVL
End DoDot:4
+29 IF TYPE'=""
Begin DoDot:4
+30 SET CT=CT+1
+31 SET @TARGET@(CT,0)="Type of Decision Making: "_TYPE
End DoDot:4
+32 IF PSYCH'=""
Begin DoDot:4
+33 SET CT=CT+1
+34 SET @TARGET@(CT,0)="Psycho/Social/Envron: "_PSYCH
End DoDot:4
+35 IF NSG'=""
Begin DoDot:4
+36 SET CT=CT+1
+37 SET @TARGET@(CT,0)="Nursing DX: "_NSG
End DoDot:4
+38 IF SHORT'=""
Begin DoDot:4
+39 SET CT=CT+1
+40 SET @TARGET@(CT,0)="Short Term Goals: "_SHORT
End DoDot:4
+41 IF LONG'=""
Begin DoDot:4
+42 SET CT=CT+1
+43 SET @TARGET@(CT,0)="Long Term Goals: "_LONG
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 IF CT=0
SET @TARGET@(1,0)="No PHNs for this patient."
+45 QUIT "~@"_$NAME(@TARGET)
+46 ;New object for current PHN Patch 1016
VPHN(DFN,TARGET) ;Return PHN for the visit context patch 1016
+1 NEW X,VST,VDT,CNT,RESULT,PHN,FNUM,LONG,LVL,NSG,PSYCH,REC,SHORT,VDATE
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+3 SET CNT=0
+4 SET FNUM=9000010.32
+5 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+6 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+7 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+8 SET PHN=""
FOR
SET PHN=$ORDER(^AUPNVPHN("AD",VST,PHN))
IF PHN=""
QUIT
Begin DoDot:1
+9 SET REC=$GET(^AUPNVPHN(PHN,0))
+10 SET LVL=$$GET1^DIQ(FNUM,PHN,.05)
+11 SET TYPE=$$GET1^DIQ(FNUM,PHN,.06)
+12 SET PSYCH=$GET(^AUPNVPHN(PHN,21))
+13 SET NSG=$GET(^AUPNVPHN(PHN,22))
+14 SET SHORT=$GET(^AUPNVPHN(PHN,23))
+15 SET LONG=$GET(^AUPNVPHN(PHN,24))
+16 SET VDATE=$$GET1^DIQ(9000010.32,PHN,.03)
+17 SET CNT=CNT+1
+18 SET @TARGET@(CNT,0)="Visit Date: "_VDATE
+19 IF LVL'=""
Begin DoDot:2
+20 SET CNT=CNT+1
+21 SET @TARGET@(CNT,0)="Level of Intervention: "_LVL
End DoDot:2
+22 IF TYPE'=""
Begin DoDot:2
+23 SET CNT=CNT+1
+24 SET @TARGET@(CNT,0)="Type of Decision Making: "_TYPE
End DoDot:2
+25 IF PSYCH'=""
Begin DoDot:2
+26 SET CNT=CNT+1
+27 SET @TARGET@(CNT,0)="Psycho/Social/Envron: "_PSYCH
End DoDot:2
+28 IF NSG'=""
Begin DoDot:2
+29 SET CNT=CNT+1
+30 SET @TARGET@(CNT,0)="Nursing DX: "_NSG
End DoDot:2
+31 IF SHORT'=""
Begin DoDot:2
+32 SET CNT=CNT+1
+33 SET @TARGET@(CNT,0)="Short Term Goals: "_SHORT
End DoDot:2
+34 IF LONG'=""
Begin DoDot:2
+35 SET CNT=CNT+1
+36 SET @TARGET@(CNT,0)="Long Term Goals: "_LONG
End DoDot:2
End DoDot:1
+37 IF CNT=0
SET @TARGET@(1,0)="No PHN for this visit."
+38 QUIT "~@"_$NAME(@TARGET)
