BEHOOGP ;IHS/MSC/MGH - Group Order API ;01-May-2012 15:58;PLS
;;1.1;BEH COMPONENTS;**011003,011005**;Sep 23,2004
Q
;===================================================================
;Input
; LST=array containing LST(n,"DFN")=PATIENT IEN
; LST(n,"PRV")=PROVIDER IEN
; LST(n,"CLN")=ICD9 code for clinical indication
; ORDITM=IEN of the orderable item(ie. screening mammogram)
; STDT=Start date/time in fileman format
; LOC=IEN of ordering location from hosital location file (File 44)
; DGRPRV = IEN of group provider (optional) (File 200)
; ORDTXT = Array of text
; Entered as ORDTXT(n,0)=TEXT
;Return array of entries in the format
;
; OUTLST(1)="12^623^ORDER CREATED"
; DFN^ORDER IEN^Additional Order TEXT
; OUTLST(2)="24^0^Duplicate order: MAMMOGRAM BILAT 9/21/10 [PENDING]"
; DFN^NOT CREATED^ERROR MESSAGE
;=====================================================================
GRPORD(OUTLST,LST,ORDITM,STDT,LOC,DGRPRV,ORDTXT) ;API Entry point to make group order
N ENTRY,DFN,PRV,PROV,DIALOG,CNT,INACT,OIOK,PKG,CI,IMGLO
S OIOK=$$OICHK(ORDITM)
I 'OIOK D ERR("Non-existent or inactive orderable item sent") Q
I $G(STDT)="" D ERR("No date/time for order sent") Q
;Find order dialog
S DIALOG=$$ODIALOG(ORDITM)
I 'DIALOG D ERR("Order dialog could not be found.") Q
S PKG=$$OPKG(DIALOG)
I PKG="" D ERR("Package data for order dialog not available") Q
I PKG="RA"&($D(ORDTXT)<10) D ERR("Missing reason for exam") Q
I PKG="RA" D I 'IMGLO D ERR("Imaging location not properly defined for this division") Q
.S IMGLO=$$IMGLOC(ORDITM)
S CNT=0
S ENTRY="" F S ENTRY=$O(LST(ENTRY)) Q:ENTRY="" D
.S DFN=$G(LST(ENTRY,"DFN"))
.S PROV=+$G(LST(ENTRY,"PRV"))
.S:'PROV PROV=$$FINDPRV()
.I 'PROV D RETERR("Unable to find provider for order") Q
.I PKG="LR" D I 'CI D RETERR("Unable to find clinical indication for order") Q
..S CI=$G(LST(ENTRY,"CLN"))
.D CREATE
Q
CREATE ; Create new OE/RR order
N ITEM,IEN,IENS,ID,IDIEN,DAT,LST,LST2,ORDCHK,NORIEN,Y
N DUR,SIGNOD,SIG,INSTNOD,DUPD,X,Z,ORDIALOG,NORIFN,ORVP,ORNP,STATUS
N DIEN,IDIEN,DUOUT,LIST,FID,OIL,DIR,OPSIEN,WP,MISLIST,ACT
; Get the orderable item
D DLGDEF^ORWDX(.LIST,"RA OERR EXAM")
S ORDIALOG=DIALOG
S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORDITM
S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=STDT
S ORDIALOG($$PTR^ORCD("OR GTX URGENCY"),1)=$O(^ORD(101.42,"B","ROUTINE",0))
S ORDIALOG($$PTR^ORCD("OR GTX LOCATION"),1)=LOC
S ORDIALOG($$PTR^ORCD("OR GTX PROVIDER"),1)=PROV
S ACT="C"_PKG
I $L($T(@ACT)) D @ACT
;Do order checks first
S FID=PKG
S OIL(1)=ORDITM
D ACCEPT^ORWDXC(.LST2,DFN,FID,STDT,1,.OIL)
I $G(LST2(1))'="" D RETERR($P(LST2(1),U,4)) Q
;Put dialog together
S ORDCHK=$$CHKORD(.ORDIALOG,.MISLIST)
I 'ORDCHK D DISPMIS(.MISLIST) Q
S ORVP=DFN_";DPT(",ORNP=PROV
D SAVE^ORWD(.Y,DFN,PROV,$G(LOC),DIALOG,"N",.ORDIALOG)
I $G(Y) S NORIEN=$P($P($P(Y(1),U),";"),"~",2)
I '$G(NORIEN) D RETERR("Order not filed.") Q
S CNT=CNT+1
S OUTLST(CNT)=DFN_U_NORIEN_U_"ORDER CREATED"
;Check for signature action
S SIG=$$GET^XPAR("ALL","BEHOOGP SIGN ORDERS",1,"I")
I SIG=1 D SIGN(.ERRLST,DFN,PROV,LOC,NORIEN)
Q
;
DISPMIS(MLIST) ;EP -
N ITEM,LINE
D RETERR("Items were missing from the order dialog.This order can not be created")
Q
; Return patient primary provider if defined, otherwise the group provider passed in.
FINDPRV() ;EP-
N PCP
S PCP=$$GET1^DIQ(9000001,DFN,.14,"I") ;pcp ien
S:'PCP PCP=$G(DGRPRV)
Q +PCP
; Add signature for either electronic or policy order
SIGN(ERRLST,DFN,ORNP,LOC,ORDER) ;EP -
N ORVP,ORL,ERRCNT,RELSTS,ACTION,SIGSTS,ORIFN,ANERROR,NATR,ORWSIGN
S RELSTS=1,ACTION=1,SIGSTS=1
S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(",ORL=ORL(2),ERRCNT=0
I '$D(^XUSEC("ORES",DUZ))&('$D(^XUSEC("ORELSE",DUZ))) Q
I $D(^XUSEC("ORES",DUZ)) S NATR="E"
I $D(^XUSEC("ORELSE",DUZ)) S NATR="I"
S ORIFN=ORDER_";1"
D EN^ORCSEND(ORIFN,"",SIGSTS,RELSTS,NATR,"",.ANERROR)
I $L(ANERROR) D Q ; don't print if an error occurred
. S OUTLST(CNT)=OUTLST(CNT)_" "_ANERROR
. K ORWSIGN(1)
I RELSTS=0 K ORWSIGN(1) Q ; don't print if unreleased
S ORWSIGN(1)=ORDER
D PRINTS^ORWD1(.ORWSIGN,LOC)
Q
; Add error text to output array if error in input validation of parameters
ERR(ERRTXT) ;EP-
S OUTLST(0)=ERRTXT
Q
; Add error text to output array if error occurs during processing or validation of patient specific information
RETERR(ERRTXT) ;EP-
S CNT=CNT+1
S OUTLST(CNT)=DFN_U_0_U_ERRTXT
Q
; Build Radiology order dialog responses
CRA ;EP-
S ORDIALOG($$PTR^ORCD("OR GTX MODE OF TRANSPORT"),1)="A"
S ORDIALOG($$PTR^ORCD("OR GTX IMAGING LOCATION"),1)=IMGLO
S ORDIALOG($$PTR^ORCD("OR GTX PREGNANT"),1)="u"
S ORDIALOG($$PTR^ORCD("OR GTX CATEGORY"),1)="O"
S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
M ORDIALOG("WP",WP,1)=ORDTXT
S ORDIALOG(WP,1)="ORDIALOG(""WP"",WP,1)"
Q
; Return imaging location associated with orderable item
IMGLOC(ORDITM) ;EP-
N RAD,RADIEN,RADTYP,ABB,X,ILOC,STOP,ORY
S STOP=0,ILOC=""
S RAD=$$GET1^DIQ(101.43,ORDITM,2,"I")
I 'RAD Q ""
S RADIEN=$P(RAD,";",1)
I 'RADIEN Q ""
S RADTYP=$$GET1^DIQ(71,RADIEN,12,"I")
I 'RADTYP Q ""
S ABB=$P($G(^RA(79.2,RADTYP,0)),U,3)
I ABB="" Q ""
D EN4^RAO7PC1(ABB,"ORY")
S X="" F S X=$O(ORY(X)) Q:X=""!(STOP=1) D
.I $P($G(ORY(X)),U,3)=DUZ(2) S ILOC=$P($G(ORY(X)),U,1),STOP=1
Q ILOC
;
; Input: OARY - ORDIALOG passed in by reference
; MLIST - List of data elements that are missing from the order (pass by ref.), returned to calling module
OICHK(ORDITM) ;EP-
;Check and get data on the orderable item
N DATE
I 'ORDITM Q ""
S DATE=$$GET1^DIQ(101.43,ORDITM,.1,"I")
I 'DATE Q 1
I STDT<DATE Q ""
Q DATE
; Return Order Dialog associated with the Orderable Item
ODIALOG(ORDITM) ;EP-
N DSPGP,DIALOG
S DSPGP=$$GET1^DIQ(101.43,ORDITM,5,"I")
I 'DSPGP Q ""
S DIALOG=$$GET1^DIQ(100.98,DSPGP,4,"I")
I 'DIALOG S DIALOG=$O(^ORD(100.98,"AD",DSPGP,""))
Q DIALOG
; Return package associated with an Order Dialog
OPKG(DIALOG) ;EP-
N PACK,AB
S PACK=$$GET1^DIQ(101.41,DIALOG,7,"I")
I 'PACK Q ""
S AB=$$GET1^DIQ(9.4,PACK,1,"E")
Q AB
; Validate input array
CHKORD(OARY,MLIST) ;EP-
N STAT,I,DONE,CHKITEM,CHKIEN
S STAT=1,DONE=0
F I=1:1 D Q:DONE
.S CHKITEM=$P($T(REQFLDS+I),";;",2)
.I '$L(CHKITEM) S DONE=1 Q
.S CHKIEN=$O(^ORD(101.41,"B",CHKITEM,0))
.I 'CHKIEN Q
. ; if the array item doesn't exist, place it in the 'missing' array and set stat to zero
.I '$D(OARY(CHKIEN)) S MLIST(CHKITEM)=CHKIEN,STAT=0 Q
. ; if the array item exists, but there is no data populated, set the 'missing' array item and stat to zero
.I $D(OARY(CHKIEN)),'$L($G(OARY(CHKIEN,1))) S MLIST(CHKITEM)=CHKIEN,STAT=0 Q
Q STAT
; Require elements for Radiology dialog
REQFLDS ;
;;OR GTX ORDERABLE ITEM
;;OR GTX WORD PROCESSING 1
;;OR GTX CATEGORY
;;OR GTX LOCATION
;;OR GTX URGENCY
;;OR GTX PREGNANT
;;OR GTX START DATE/TIME
;;OR GTX MODE OF TRANSPORT
;;OR GTX IMAGING LOCATION
;;OR GTX PROVIDER
;;
Q
BEHOOGP ;IHS/MSC/MGH - Group Order API ;01-May-2012 15:58;PLS
+1 ;;1.1;BEH COMPONENTS;**011003,011005**;Sep 23,2004
+2 QUIT
+3 ;===================================================================
+4 ;Input
+5 ; LST=array containing LST(n,"DFN")=PATIENT IEN
+6 ; LST(n,"PRV")=PROVIDER IEN
+7 ; LST(n,"CLN")=ICD9 code for clinical indication
+8 ; ORDITM=IEN of the orderable item(ie. screening mammogram)
+9 ; STDT=Start date/time in fileman format
+10 ; LOC=IEN of ordering location from hosital location file (File 44)
+11 ; DGRPRV = IEN of group provider (optional) (File 200)
+12 ; ORDTXT = Array of text
+13 ; Entered as ORDTXT(n,0)=TEXT
+14 ;Return array of entries in the format
+15 ;
+16 ; OUTLST(1)="12^623^ORDER CREATED"
+17 ; DFN^ORDER IEN^Additional Order TEXT
+18 ; OUTLST(2)="24^0^Duplicate order: MAMMOGRAM BILAT 9/21/10 [PENDING]"
+19 ; DFN^NOT CREATED^ERROR MESSAGE
+20 ;=====================================================================
GRPORD(OUTLST,LST,ORDITM,STDT,LOC,DGRPRV,ORDTXT) ;API Entry point to make group order
+1 NEW ENTRY,DFN,PRV,PROV,DIALOG,CNT,INACT,OIOK,PKG,CI,IMGLO
+2 SET OIOK=$$OICHK(ORDITM)
+3 IF 'OIOK
DO ERR("Non-existent or inactive orderable item sent")
QUIT
+4 IF $GET(STDT)=""
DO ERR("No date/time for order sent")
QUIT
+5 ;Find order dialog
+6 SET DIALOG=$$ODIALOG(ORDITM)
+7 IF 'DIALOG
DO ERR("Order dialog could not be found.")
QUIT
+8 SET PKG=$$OPKG(DIALOG)
+9 IF PKG=""
DO ERR("Package data for order dialog not available")
QUIT
+10 IF PKG="RA"&($DATA(ORDTXT)<10)
DO ERR("Missing reason for exam")
QUIT
+11 IF PKG="RA"
Begin DoDot:1
+12 SET IMGLO=$$IMGLOC(ORDITM)
End DoDot:1
IF 'IMGLO
DO ERR("Imaging location not properly defined for this division")
QUIT
+13 SET CNT=0
+14 SET ENTRY=""
FOR
SET ENTRY=$ORDER(LST(ENTRY))
IF ENTRY=""
QUIT
Begin DoDot:1
+15 SET DFN=$GET(LST(ENTRY,"DFN"))
+16 SET PROV=+$GET(LST(ENTRY,"PRV"))
+17 IF 'PROV
SET PROV=$$FINDPRV()
+18 IF 'PROV
DO RETERR("Unable to find provider for order")
QUIT
+19 IF PKG="LR"
Begin DoDot:2
+20 SET CI=$GET(LST(ENTRY,"CLN"))
End DoDot:2
IF 'CI
DO RETERR("Unable to find clinical indication for order")
QUIT
+21 DO CREATE
End DoDot:1
+22 QUIT
CREATE ; Create new OE/RR order
+1 NEW ITEM,IEN,IENS,ID,IDIEN,DAT,LST,LST2,ORDCHK,NORIEN,Y
+2 NEW DUR,SIGNOD,SIG,INSTNOD,DUPD,X,Z,ORDIALOG,NORIFN,ORVP,ORNP,STATUS
+3 NEW DIEN,IDIEN,DUOUT,LIST,FID,OIL,DIR,OPSIEN,WP,MISLIST,ACT
+4 ; Get the orderable item
+5 DO DLGDEF^ORWDX(.LIST,"RA OERR EXAM")
+6 SET ORDIALOG=DIALOG
+7 SET ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORDITM
+8 SET ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=STDT
+9 SET ORDIALOG($$PTR^ORCD("OR GTX URGENCY"),1)=$ORDER(^ORD(101.42,"B","ROUTINE",0))
+10 SET ORDIALOG($$PTR^ORCD("OR GTX LOCATION"),1)=LOC
+11 SET ORDIALOG($$PTR^ORCD("OR GTX PROVIDER"),1)=PROV
+12 SET ACT="C"_PKG
+13 IF $LENGTH($TEXT(@ACT))
DO @ACT
+14 ;Do order checks first
+15 SET FID=PKG
+16 SET OIL(1)=ORDITM
+17 DO ACCEPT^ORWDXC(.LST2,DFN,FID,STDT,1,.OIL)
+18 IF $GET(LST2(1))'=""
DO RETERR($PIECE(LST2(1),U,4))
QUIT
+19 ;Put dialog together
+20 SET ORDCHK=$$CHKORD(.ORDIALOG,.MISLIST)
+21 IF 'ORDCHK
DO DISPMIS(.MISLIST)
QUIT
+22 SET ORVP=DFN_";DPT("
SET ORNP=PROV
+23 DO SAVE^ORWD(.Y,DFN,PROV,$GET(LOC),DIALOG,"N",.ORDIALOG)
+24 IF $GET(Y)
SET NORIEN=$PIECE($PIECE($PIECE(Y(1),U),";"),"~",2)
+25 IF '$GET(NORIEN)
DO RETERR("Order not filed.")
QUIT
+26 SET CNT=CNT+1
+27 SET OUTLST(CNT)=DFN_U_NORIEN_U_"ORDER CREATED"
+28 ;Check for signature action
+29 SET SIG=$$GET^XPAR("ALL","BEHOOGP SIGN ORDERS",1,"I")
+30 IF SIG=1
DO SIGN(.ERRLST,DFN,PROV,LOC,NORIEN)
+31 QUIT
+32 ;
DISPMIS(MLIST) ;EP -
+1 NEW ITEM,LINE
+2 DO RETERR("Items were missing from the order dialog.This order can not be created")
+3 QUIT
+4 ; Return patient primary provider if defined, otherwise the group provider passed in.
FINDPRV() ;EP-
+1 NEW PCP
+2 ;pcp ien
SET PCP=$$GET1^DIQ(9000001,DFN,.14,"I")
+3 IF 'PCP
SET PCP=$GET(DGRPRV)
+4 QUIT +PCP
+5 ; Add signature for either electronic or policy order
SIGN(ERRLST,DFN,ORNP,LOC,ORDER) ;EP -
+1 NEW ORVP,ORL,ERRCNT,RELSTS,ACTION,SIGSTS,ORIFN,ANERROR,NATR,ORWSIGN
+2 SET RELSTS=1
SET ACTION=1
SET SIGSTS=1
+3 SET ORVP=DFN_";DPT("
SET ORL(2)=LOC_";SC("
SET ORL=ORL(2)
SET ERRCNT=0
+4 IF '$DATA(^XUSEC("ORES",DUZ))&('$DATA(^XUSEC("ORELSE",DUZ)))
QUIT
+5 IF $DATA(^XUSEC("ORES",DUZ))
SET NATR="E"
+6 IF $DATA(^XUSEC("ORELSE",DUZ))
SET NATR="I"
+7 SET ORIFN=ORDER_";1"
+8 DO EN^ORCSEND(ORIFN,"",SIGSTS,RELSTS,NATR,"",.ANERROR)
+9 ; don't print if an error occurred
IF $LENGTH(ANERROR)
Begin DoDot:1
+10 SET OUTLST(CNT)=OUTLST(CNT)_" "_ANERROR
+11 KILL ORWSIGN(1)
End DoDot:1
QUIT
+12 ; don't print if unreleased
IF RELSTS=0
KILL ORWSIGN(1)
QUIT
+13 SET ORWSIGN(1)=ORDER
+14 DO PRINTS^ORWD1(.ORWSIGN,LOC)
+15 QUIT
+16 ; Add error text to output array if error in input validation of parameters
ERR(ERRTXT) ;EP-
+1 SET OUTLST(0)=ERRTXT
+2 QUIT
+3 ; Add error text to output array if error occurs during processing or validation of patient specific information
RETERR(ERRTXT) ;EP-
+1 SET CNT=CNT+1
+2 SET OUTLST(CNT)=DFN_U_0_U_ERRTXT
+3 QUIT
+4 ; Build Radiology order dialog responses
CRA ;EP-
+1 SET ORDIALOG($$PTR^ORCD("OR GTX MODE OF TRANSPORT"),1)="A"
+2 SET ORDIALOG($$PTR^ORCD("OR GTX IMAGING LOCATION"),1)=IMGLO
+3 SET ORDIALOG($$PTR^ORCD("OR GTX PREGNANT"),1)="u"
+4 SET ORDIALOG($$PTR^ORCD("OR GTX CATEGORY"),1)="O"
+5 SET WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
+6 MERGE ORDIALOG("WP",WP,1)=ORDTXT
+7 SET ORDIALOG(WP,1)="ORDIALOG(""WP"",WP,1)"
+8 QUIT
+9 ; Return imaging location associated with orderable item
IMGLOC(ORDITM) ;EP-
+1 NEW RAD,RADIEN,RADTYP,ABB,X,ILOC,STOP,ORY
+2 SET STOP=0
SET ILOC=""
+3 SET RAD=$$GET1^DIQ(101.43,ORDITM,2,"I")
+4 IF 'RAD
QUIT ""
+5 SET RADIEN=$PIECE(RAD,";",1)
+6 IF 'RADIEN
QUIT ""
+7 SET RADTYP=$$GET1^DIQ(71,RADIEN,12,"I")
+8 IF 'RADTYP
QUIT ""
+9 SET ABB=$PIECE($GET(^RA(79.2,RADTYP,0)),U,3)
+10 IF ABB=""
QUIT ""
+11 DO EN4^RAO7PC1(ABB,"ORY")
+12 SET X=""
FOR
SET X=$ORDER(ORY(X))
IF X=""!(STOP=1)
QUIT
Begin DoDot:1
+13 IF $PIECE($GET(ORY(X)),U,3)=DUZ(2)
SET ILOC=$PIECE($GET(ORY(X)),U,1)
SET STOP=1
End DoDot:1
+14 QUIT ILOC
+15 ;
+16 ; Input: OARY - ORDIALOG passed in by reference
+17 ; MLIST - List of data elements that are missing from the order (pass by ref.), returned to calling module
OICHK(ORDITM) ;EP-
+1 ;Check and get data on the orderable item
+2 NEW DATE
+3 IF 'ORDITM
QUIT ""
+4 SET DATE=$$GET1^DIQ(101.43,ORDITM,.1,"I")
+5 IF 'DATE
QUIT 1
+6 IF STDT<DATE
QUIT ""
+7 QUIT DATE
+8 ; Return Order Dialog associated with the Orderable Item
ODIALOG(ORDITM) ;EP-
+1 NEW DSPGP,DIALOG
+2 SET DSPGP=$$GET1^DIQ(101.43,ORDITM,5,"I")
+3 IF 'DSPGP
QUIT ""
+4 SET DIALOG=$$GET1^DIQ(100.98,DSPGP,4,"I")
+5 IF 'DIALOG
SET DIALOG=$ORDER(^ORD(100.98,"AD",DSPGP,""))
+6 QUIT DIALOG
+7 ; Return package associated with an Order Dialog
OPKG(DIALOG) ;EP-
+1 NEW PACK,AB
+2 SET PACK=$$GET1^DIQ(101.41,DIALOG,7,"I")
+3 IF 'PACK
QUIT ""
+4 SET AB=$$GET1^DIQ(9.4,PACK,1,"E")
+5 QUIT AB
+6 ; Validate input array
CHKORD(OARY,MLIST) ;EP-
+1 NEW STAT,I,DONE,CHKITEM,CHKIEN
+2 SET STAT=1
SET DONE=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET CHKITEM=$PIECE($TEXT(REQFLDS+I),";;",2)
+5 IF '$LENGTH(CHKITEM)
SET DONE=1
QUIT
+6 SET CHKIEN=$ORDER(^ORD(101.41,"B",CHKITEM,0))
+7 IF 'CHKIEN
QUIT
+8 ; if the array item doesn't exist, place it in the 'missing' array and set stat to zero
+9 IF '$DATA(OARY(CHKIEN))
SET MLIST(CHKITEM)=CHKIEN
SET STAT=0
QUIT
+10 ; if the array item exists, but there is no data populated, set the 'missing' array item and stat to zero
+11 IF $DATA(OARY(CHKIEN))
IF '$LENGTH($GET(OARY(CHKIEN,1)))
SET MLIST(CHKITEM)=CHKIEN
SET STAT=0
QUIT
End DoDot:1
IF DONE
QUIT
+12 QUIT STAT
+13 ; Require elements for Radiology dialog
REQFLDS ;
+1 ;;OR GTX ORDERABLE ITEM
+2 ;;OR GTX WORD PROCESSING 1
+3 ;;OR GTX CATEGORY
+4 ;;OR GTX LOCATION
+5 ;;OR GTX URGENCY
+6 ;;OR GTX PREGNANT
+7 ;;OR GTX START DATE/TIME
+8 ;;OR GTX MODE OF TRANSPORT
+9 ;;OR GTX IMAGING LOCATION
+10 ;;OR GTX PROVIDER
+11 ;;
+12 QUIT
