APSPESLP ;IHS/BWF - Process entries from APSP REFILL REQUEST file ;02-May-2013 18:07;DU
;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1009,1013,1016**;Sep 23,2004;Build 74
; IHS/MSC/MGH Added middle name for patch 1016
EN ; -- main entry point for APSP LM REFILL REQUEST
D:'$D(PSOPAR) ^PSOLSET ;P1013
D EN^VALM("APSP LM REFILL REQUEST")
Q
;
HDR ; -- header code
Q
;
INIT ; -- init variables and list array
N LINE,MSGID,IEN,SEG,HLDATA,APSPMSH,APSPPID,APSPORC,APSPRX0,APSPRXE,DRUG,PAT,PATLN,PATFN,LINEVAR,ITMDATE
N PATNAME,STAT
S VALMCNT=0
S (IEN,LINE)=0 F S IEN=$O(^APSPRREQ(IEN)) Q:'IEN D
.; do not display if the status is 'processed', there is an OERR order number, or the HL7 data is misisng
.I $P(^APSPRREQ(IEN,0),U,2)!('$O(^APSPRREQ(IEN,5,0))) Q
.S STAT=+$$GET1^DIQ(9009033.91,IEN,.03,"I") I "1235"[STAT Q
.S MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E"),HLMSG=$$GHLDAT(IEN)
.D SHLVARS
.S PATNAME=$$PATNAME(APSPPID)
.S DRUG=$P($P(APSPRXO,"|",2),U,2)
.S ITMDATE=$$GET1^DIQ(9009033.91,IEN,.04,"I")
.S ITMDATE=$$FMTE^XLFDT($P(ITMDATE,"."),"5Z")
.; Set up record
.S LINE=LINE+1,VALMCNT=VALMCNT+1
.S LINEVAR=""
.S LINEVAR=$$SETFLD^VALM1(LINE_".",LINEVAR,"ITEM")
.S LINEVAR=$$SETFLD^VALM1(PATNAME,LINEVAR,"PATIENT")
.S LINEVAR=$$SETFLD^VALM1(DRUG,LINEVAR,"DRUG")
.S LINEVAR=$$SETFLD^VALM1(MSGID,LINEVAR,"MSGID")
.S LINEVAR=$$SETFLD^VALM1(ITMDATE,LINEVAR,"DATE")
.D SET^VALM10(LINE,LINEVAR,IEN)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
N HLMSG
S HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
Q HLMSG
;
SHLVARS ; Set up HL segment data
N SEGTYP,VAR
F SEGTYP="MSH","PID","ORC","RXO","RXE","RXR" S VAR="APSP"_SEGTYP,@VAR="" S @VAR=$$GETSEG(.HLDATA,SEGTYP)
Q
; Input: DATA - HL7 data from APSP REFILL REQUEST file
; TYPE - Message segment requested
GETSEG(DATA,TYPE) ;
N X,RET,Q
S RET="",(X,Q)=0 F S X=$O(DATA(X)) Q:'X!(Q) D
.S DAT=$G(DATA(X)) I DAT="" S RET="" Q
.I $P(DAT,"|")=TYPE S RET=DAT,Q=1 Q
Q RET
;
CREATE ; Create new OE/RR order
N ITEM,HLMSG,APSPMSH,APSPPID,APSPORC,APSPRXO,APSPRXE,IEN,IENS,ID,IDIEN,DAT,DFN,PROV,UNITS,NOUN
N DUR,CONJ,VERB,SIGNOD,INSTNOD,SIG,DUPD,X,Z,ORDIALOG,NORIFN,ORVP,DIALOG,ORNP,STATUS,APSPRXO
N APSPRXE,APSPRXR,APSPORC,APSPPID,DIEN,IDIEN,DUOUT,FIL2,FIL3,FIL,LIST,LOC,ROUTE,CNT,DIR,PHARM
N CLININD,OPSIEN,SSRTEXT,DAW,MISLIST
; item selection
I '$O(@VALMAR@(0)) D BACK Q
S ITEM=$$SELITEM() I 'ITEM!(ITEM["^") D BACK Q
S FIL=9009033.91,FIL2=9009033.912,FIL3=9009033.913
; set up hl7 variables
S HLMSG=$$GHLDAT(ITEM) D SHLVARS
; get data from APSP REFILL REQUESTS FILE
D PREPPTXT^APSPES2("PTXT",ITEM)
I $D(PTXT) D
.S $P(LINE,"-",80)="" W !,LINE,!,"Displaying order information"
.D FULL^VALM1
.S I=0 F S I=$O(PTXT(I)) Q:'I W !,PTXT(I)
.W !,LINE
S CHKPROC=$$DIRYN^APSPUTIL("Are you sure you wish to create this order?","YES",,.POP) I POP D BACK Q
D GETS^DIQ(9009033.91,ITEM,"**","IE","DATA")
S IEN=ITEM_","
; quit if status is 'PROCESSED' or 'PROCESSING'
S STATUS=+$G(DATA(FIL,IEN,.03,"I")) I "235"[STATUS D BACK Q
S LOC=$$GET1^DIQ(9009033.91,ITEM,1.6,"I")
S PHARM=$$GET1^DIQ(9009033.91,ITEM,1.7,"I")
; Get the orderable item
S DAT("ORDERABLE")=$G(DATA(FIL,IEN,1.1,"I"))
I 'DAT("ORDERABLE") D FULL^VALM1 W !!,"No orderable item defined. Can not process." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
I '$D(DATA(FIL,IEN,1.5,"E")) W !!,"Days Supply not defined. Can not process." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
; get the IEN and try to locate the drug from ^PSDRUG
S ID=$$GET1^DIQ(101.43,DAT("ORDERABLE"),2,"E"),IDIEN=$P(ID,";"),DAT("DRUG")=$O(^PSDRUG("ASP",IDIEN,0))
S DFN=$G(DATA(FIL,IEN,1.2,"I")),PROV=$G(DATA(FIL,IEN,1.3,"I"))
S DAT("QTY")=+$G(DATA(FIL,IEN,1.4,"E")),DAT("SUPPLY")=$G(DATA(FIL,IEN,1.5,"E"))
S INSTNOD=$O(^APSPRREQ(ITEM,2,0))
I 'INSTNOD D FULL^VALM1 W !!,"No medication instructions, can not process entry." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
; Get all possible doses
S INST=0,CNT=1
F S INST=$O(^APSPRREQ(ITEM,2,INST)) Q:'INST D
.S IENS=INST_","_IEN
.S (DAT("DOSE",CNT),DAT("INSTR",CNT),DAT("STRENGTH",CNT))=$G(DATA(FIL2,IENS,.01,"E")),DUPD=$G(DATA(FIL2,IENS,1,"E"))
.S UNITS=$G(DATA(FIL2,IENS,2,"I"))
.S NOUN=$G(DATA(FIL2,IENS,3,"E")),DUR=$G(DATA(FIL2,IENS,4,"E")),DAT("CONJ")=$G(DATA(FIL2,IENS,5,"I"))
.S DAT("ROUTE",CNT)=$G(DATA(FIL2,IENS,6,"I")),DAT("SCHEDULE",CNT)=$G(DATA(FIL2,IENS,7,"E")),VERB=$G(DATA(FIL2,IENS,8,"E"))
.S CNT=CNT+1
;
S DAT("REFILLS")=0
; Get clinical indicator and build array for the data element. This field can be a multiple.
; TODO - parse apart clinical indicator to set both CLININD and CLININD2
S CLININD=$P(APSPRXO,"|",21)
S DONE=1
; Set up clinical indicator and REFREQ IEN into ORDIALOG
F I=1:1 D Q:DONE
.I $P(CLININD,U,I)']"" Q
.S ORDIALOG($$PTR^ORCD("OR GTX CLININD"),I)=$P(CLININD,U,I)
S ORDIALOG($$PTR^ORCD("OR GTX SSRREQIEN"),1)=ITEM
S DAW=$P($G(APSPRXO),"|",10)
S ORDIALOG($$PTR^ORCD("OR GTX DAW"),1)=DAW
D PREPPTXT^APSPES2("SSRTEXT",ITEM)
S I=0 F S I=$O(SSRTEXT(I)) Q:'I D
.S TXT=$G(SSRTEXT(I))
.S NSSRTXT(I,0)=TXT
S ORDIALOG($$PTR^ORCD("OR GTX SSREFREQ"),1)="NSSRTXT"
S ORDIALOG($$PTR^ORCD("OR GTX PHARMACY"),1)=PHARM
S SIGNOD=0
I '$O(^APSPRREQ(ITEM,3,SIGNOD)) D FULL^VALM1 W !,"No signature, can not process entry." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
F S SIGNOD=$O(^APSPRREQ(ITEM,3,SIGNOD)) Q:'SIGNOD D
.S IENS=SIGNOD_","_IEN
.S DAT("SIG",SIGNOD,0)=$G(DATA(FIL3,IENS,.01,"E"))
S DIALOG=$O(^ORD(101.41,"B","PSO OERR",0))
I 'DIALOG D FULL^VALM1 W !,"Order dialog 'PSO OERR' could not be found." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
D DLGDEF^ORWDX(.LIST,"PSO OERR")
S ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0))
F X="ORDERABLE","INSTR","ROUTE","SCHEDULE","QTY","SIG","DOSE","DRUG","CONJ","SUPPLY","REFILLS" D
.S Z=0 F S Z=$O(LIST(Z)) Q:'Z D
..I $P($G(LIST(Z)),U)=X D
...S DIEN=$P(LIST(Z),U,2)
...I X="SIG" S ORDIALOG(DIEN,1)="DAT(""SIG"")" Q
...I $O(DAT(X,0)) D Q
....S SN=0 F S SN=$O(DAT(X,SN)) Q:'SN D
.....S ORDIALOG(DIEN,SN)=$G(DAT(X,SN))
...S ORDIALOG(DIEN,1)=$G(DAT(X))
S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)="E"
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 ORDCHK=$$CHKORD(.ORDIALOG,.MISLIST)
I 'ORDCHK D DISPMIS(.MISLIST) S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
I '$$SCREEN^APSPMULT(+$G(DAT("DRUG")),,1) W !,"Not a valid refill drug" S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q ;IHS/MSC/JDS - 11/20/2010
S ORVP=DFN_";DPT(",ORNP=PROV
D SAVE^ORWD(.Y,DFN,PROV,$G(LOC),DIALOG,"N",.ORDIALOG)
I $G(Y) S NORIFN=$P($P($P(Y(1),U),";"),"~",2)
I '$G(NORIFN) D FULL^VALM1 W !,"Order not filed.",!,"Check data and try again." S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
D EN^OCXOERR(DFN_U_+NORIFN_U_PROV_"^^^^^1")
S FDA(9009033.91,ITEM_",",.02)=NORIFN
S FDA(9009033.91,ITEM_",",.03)=1
S FDA(9009033.91,ITEM_",",.07)=$$NOW^XLFDT()
D FILE^DIE(,"FDA") K FDA
D BACK
Q
DISPHL7(PAT,QTY,PROV,DRUG,NOTE,STR,UNITS,ROUTE,NOUN,SCHARY,MEDUNITS,REFILLS,PHARM,SIG,ARY) ; Display HL7 data
N LINE,K
W !!
S $P(LINE,"-",80)=""
W LINE
W !," Displaying incoming HL7 data:",!
W !," Patient: "_PAT
W !," Provider: "_PROV
W !," Medication: "_DRUG
W !," SIG: "_SIG
W !," Note: "_NOTE
W !," Quantity: "_QTY
W !," Refills: "_REFILLS
W !," Pharmacy: "_PHARM
W !!," Dosing information: (multiple line items indicates complex dosing)"
W:$D(SCHARY) !,?3,"Units/Dose",?15,"Interval",?25,"Duration",?35,"Conjunction"
F K=1:1 D Q:'$D(SCHARY(K))
.I $D(SCHARY(K)) W !,?5,$P(SCHARY(K),U),?15,$P(SCHARY(K),U,2),?25,$P(SCHARY(K),U,3),?35,$P(SCHARY(K),U,4)
W !,LINE
Q
;
;
CHKDEF(IEN,TEXT) ;
N FOUND,X
S FOUND=0
S X=0 F S X=$O(^APSPRREQ(ITEM,3,X)) Q:'X D
.I $G(^APSPRREQ(ITEM,3,X,0))=TEXT S FOUND=1
Q FOUND
SELITEM() ;
N MAX,PARAM,DPRMPT,ITEM,IEN
S MAX=$O(^TMP("VALMAR",$J,VALMEVL,"IDX",""),-1)
S PARAM="NO^1:"_MAX,DPRMPT="Select Entry"
; Prompt for item to edit
S ITEM=$$DIR^APSPUTIL(PARAM,DPRMPT)
I 'ITEM Q 0
I '$D(^TMP("VALMAR",$J,VALMEVL,"IDX",ITEM)) Q 0
S IEN=$O(^TMP("VALMAR",$J,VALMEVL,"IDX",ITEM,0))
Q IEN
PATNAME(PIDSEG) ;
N PAT,PATLN,PATFN,PATNAME,PATMN
S PAT=$P(PIDSEG,"|",6) I '$L(PAT) Q ""
S PATLN=$P(PAT,U),PATFN=$P(PAT,U,2),PATMN=$P(PAT,U,3)
S PATNAME=PATLN_","_PATFN_" "_PATMN
Q PATNAME
BACK ;
;L -^APSPRREQ(ITEM)
K @VALMAR D INIT
S VALMBCK="R"
Q
;
; Builds array of control data
BLDARY(FLDARY) ;
N QUIT,TEXT
S QUIT=0
F I=1:1 D Q:QUIT
.S TEXT=$T(FLDLST+I) I $P(TEXT,";;",2)="" S QUIT=1 Q
.S FLDARY(I)=$T(FLDLST+I)
Q
; Parameterized DIE call for top level field
PRMPT(FILE,IENS,FLD,DFT) ; PROMPT FIELD
N DIE,DA,DR,Y,X
S DIE("NO^")="OUTOK"
S DIE=FILE,DA=IENS,DR=FLD_"//"_$S($L($G(DFT)):DFT,1:"") D ^DIE
Q $D(Y)
;
;Parameterized DIE call for subfile
PRMPT2(FILE,TIEN,SIEN,FLD,NODE,DFT) ;
N DIE,DA,DR,Y,X,DEL
S DEL=0
S DIE("NO^")="OUTOK"
S DIE="^APSPRREQ("_ITEM_","_NODE_",",DA(1)=TIEN,DA=SIEN,DR=FLD_"//"_$S($D(DFT):DFT,1:"") D ^DIE
I '$D(DA) S DEL=1
Q $D(Y)_"|"_DEL
;
GETIEN(FILE,PRMT,DEF,POP) ;
N DIC,APSPD,Y
S POP=0
I '$D(DEF) S DEF=" "
S APSPD=$$GET1^DIQ(FILE,$$FIND1^DIC(FILE,,,DEF),.01)
S DIC=FILE,DIC(0)="AE",DIC("A")=$G(PRMT),DIC("B")=APSPD
D ^DIC
S:Y'>0 POP=1
Q +Y
; Display missing data elements to user.
; input - MLIST (from CHKORD), passed by reference
DISPMIS(MLIST) ;
N ITEM,LINE
S $P(LINE,"-",80)="" W !!,LINE
W !,"The following items are not defined. This order can not be created."
W !,"Please correct these items and try again."
S ITEM="" F S ITEM=$O(MLIST(ITEM)) Q:ITEM']"" D
.W !,ITEM
W !,LINE
Q
; 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
CHKORD(OARY,MLIST) ;
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
REQFLDS ;
;;OR GTX ORDERABLE ITEM
;;OR GTX INSTRUCTIONS
;;OR GTX ROUTE
;;OR GTX SCHEDULE
;;OR GTX URGENCY
;;OR GTX ROUTING
;;OR GTX REFILLS
;;OR GTX DAYS SUPPLY
;;OR GTX PHARMACY
;;OR GTX DAW
;;OR GTX SSREFREQ
;;OR GTX SSRREQIEN
;;
Q
APSPESLP ;IHS/BWF - Process entries from APSP REFILL REQUEST file ;02-May-2013 18:07;DU
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1009,1013,1016**;Sep 23,2004;Build 74
+2 ; IHS/MSC/MGH Added middle name for patch 1016
EN ; -- main entry point for APSP LM REFILL REQUEST
+1 ;P1013
IF '$DATA(PSOPAR)
DO ^PSOLSET
+2 DO EN^VALM("APSP LM REFILL REQUEST")
+3 QUIT
+4 ;
HDR ; -- header code
+1 QUIT
+2 ;
INIT ; -- init variables and list array
+1 NEW LINE,MSGID,IEN,SEG,HLDATA,APSPMSH,APSPPID,APSPORC,APSPRX0,APSPRXE,DRUG,PAT,PATLN,PATFN,LINEVAR,ITMDATE
+2 NEW PATNAME,STAT
+3 SET VALMCNT=0
+4 SET (IEN,LINE)=0
FOR
SET IEN=$ORDER(^APSPRREQ(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 ; do not display if the status is 'processed', there is an OERR order number, or the HL7 data is misisng
+6 IF $PIECE(^APSPRREQ(IEN,0),U,2)!('$ORDER(^APSPRREQ(IEN,5,0)))
QUIT
+7 SET STAT=+$$GET1^DIQ(9009033.91,IEN,.03,"I")
IF "1235"[STAT
QUIT
+8 SET MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E")
SET HLMSG=$$GHLDAT(IEN)
+9 DO SHLVARS
+10 SET PATNAME=$$PATNAME(APSPPID)
+11 SET DRUG=$PIECE($PIECE(APSPRXO,"|",2),U,2)
+12 SET ITMDATE=$$GET1^DIQ(9009033.91,IEN,.04,"I")
+13 SET ITMDATE=$$FMTE^XLFDT($PIECE(ITMDATE,"."),"5Z")
+14 ; Set up record
+15 SET LINE=LINE+1
SET VALMCNT=VALMCNT+1
+16 SET LINEVAR=""
+17 SET LINEVAR=$$SETFLD^VALM1(LINE_".",LINEVAR,"ITEM")
+18 SET LINEVAR=$$SETFLD^VALM1(PATNAME,LINEVAR,"PATIENT")
+19 SET LINEVAR=$$SETFLD^VALM1(DRUG,LINEVAR,"DRUG")
+20 SET LINEVAR=$$SETFLD^VALM1(MSGID,LINEVAR,"MSGID")
+21 SET LINEVAR=$$SETFLD^VALM1(ITMDATE,LINEVAR,"DATE")
+22 DO SET^VALM10(LINE,LINEVAR,IEN)
End DoDot:1
+23 QUIT
+24 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 DO FULL^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
+1 NEW HLMSG
+2 SET HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
+3 QUIT HLMSG
+4 ;
SHLVARS ; Set up HL segment data
+1 NEW SEGTYP,VAR
+2 FOR SEGTYP="MSH","PID","ORC","RXO","RXE","RXR"
SET VAR="APSP"_SEGTYP
SET @VAR=""
SET @VAR=$$GETSEG(.HLDATA,SEGTYP)
+3 QUIT
+4 ; Input: DATA - HL7 data from APSP REFILL REQUEST file
+5 ; TYPE - Message segment requested
GETSEG(DATA,TYPE) ;
+1 NEW X,RET,Q
+2 SET RET=""
SET (X,Q)=0
FOR
SET X=$ORDER(DATA(X))
IF 'X!(Q)
QUIT
Begin DoDot:1
+3 SET DAT=$GET(DATA(X))
IF DAT=""
SET RET=""
QUIT
+4 IF $PIECE(DAT,"|")=TYPE
SET RET=DAT
SET Q=1
QUIT
End DoDot:1
+5 QUIT RET
+6 ;
CREATE ; Create new OE/RR order
+1 NEW ITEM,HLMSG,APSPMSH,APSPPID,APSPORC,APSPRXO,APSPRXE,IEN,IENS,ID,IDIEN,DAT,DFN,PROV,UNITS,NOUN
+2 NEW DUR,CONJ,VERB,SIGNOD,INSTNOD,SIG,DUPD,X,Z,ORDIALOG,NORIFN,ORVP,DIALOG,ORNP,STATUS,APSPRXO
+3 NEW APSPRXE,APSPRXR,APSPORC,APSPPID,DIEN,IDIEN,DUOUT,FIL2,FIL3,FIL,LIST,LOC,ROUTE,CNT,DIR,PHARM
+4 NEW CLININD,OPSIEN,SSRTEXT,DAW,MISLIST
+5 ; item selection
+6 IF '$ORDER(@VALMAR@(0))
DO BACK
QUIT
+7 SET ITEM=$$SELITEM()
IF 'ITEM!(ITEM["^")
DO BACK
QUIT
+8 SET FIL=9009033.91
SET FIL2=9009033.912
SET FIL3=9009033.913
+9 ; set up hl7 variables
+10 SET HLMSG=$$GHLDAT(ITEM)
DO SHLVARS
+11 ; get data from APSP REFILL REQUESTS FILE
+12 DO PREPPTXT^APSPES2("PTXT",ITEM)
+13 IF $DATA(PTXT)
Begin DoDot:1
+14 SET $PIECE(LINE,"-",80)=""
WRITE !,LINE,!,"Displaying order information"
+15 DO FULL^VALM1
+16 SET I=0
FOR
SET I=$ORDER(PTXT(I))
IF 'I
QUIT
WRITE !,PTXT(I)
+17 WRITE !,LINE
End DoDot:1
+18 SET CHKPROC=$$DIRYN^APSPUTIL("Are you sure you wish to create this order?","YES",,.POP)
IF POP
DO BACK
QUIT
+19 DO GETS^DIQ(9009033.91,ITEM,"**","IE","DATA")
+20 SET IEN=ITEM_","
+21 ; quit if status is 'PROCESSED' or 'PROCESSING'
+22 SET STATUS=+$GET(DATA(FIL,IEN,.03,"I"))
IF "235"[STATUS
DO BACK
QUIT
+23 SET LOC=$$GET1^DIQ(9009033.91,ITEM,1.6,"I")
+24 SET PHARM=$$GET1^DIQ(9009033.91,ITEM,1.7,"I")
+25 ; Get the orderable item
+26 SET DAT("ORDERABLE")=$GET(DATA(FIL,IEN,1.1,"I"))
+27 IF 'DAT("ORDERABLE")
DO FULL^VALM1
WRITE !!,"No orderable item defined. Can not process."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+28 IF '$DATA(DATA(FIL,IEN,1.5,"E"))
WRITE !!,"Days Supply not defined. Can not process."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+29 ; get the IEN and try to locate the drug from ^PSDRUG
+30 SET ID=$$GET1^DIQ(101.43,DAT("ORDERABLE"),2,"E")
SET IDIEN=$PIECE(ID,";")
SET DAT("DRUG")=$ORDER(^PSDRUG("ASP",IDIEN,0))
+31 SET DFN=$GET(DATA(FIL,IEN,1.2,"I"))
SET PROV=$GET(DATA(FIL,IEN,1.3,"I"))
+32 SET DAT("QTY")=+$GET(DATA(FIL,IEN,1.4,"E"))
SET DAT("SUPPLY")=$GET(DATA(FIL,IEN,1.5,"E"))
+33 SET INSTNOD=$ORDER(^APSPRREQ(ITEM,2,0))
+34 IF 'INSTNOD
DO FULL^VALM1
WRITE !!,"No medication instructions, can not process entry."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+35 ; Get all possible doses
+36 SET INST=0
SET CNT=1
+37 FOR
SET INST=$ORDER(^APSPRREQ(ITEM,2,INST))
IF 'INST
QUIT
Begin DoDot:1
+38 SET IENS=INST_","_IEN
+39 SET (DAT("DOSE",CNT),DAT("INSTR",CNT),DAT("STRENGTH",CNT))=$GET(DATA(FIL2,IENS,.01,"E"))
SET DUPD=$GET(DATA(FIL2,IENS,1,"E"))
+40 SET UNITS=$GET(DATA(FIL2,IENS,2,"I"))
+41 SET NOUN=$GET(DATA(FIL2,IENS,3,"E"))
SET DUR=$GET(DATA(FIL2,IENS,4,"E"))
SET DAT("CONJ")=$GET(DATA(FIL2,IENS,5,"I"))
+42 SET DAT("ROUTE",CNT)=$GET(DATA(FIL2,IENS,6,"I"))
SET DAT("SCHEDULE",CNT)=$GET(DATA(FIL2,IENS,7,"E"))
SET VERB=$GET(DATA(FIL2,IENS,8,"E"))
+43 SET CNT=CNT+1
End DoDot:1
+44 ;
+45 SET DAT("REFILLS")=0
+46 ; Get clinical indicator and build array for the data element. This field can be a multiple.
+47 ; TODO - parse apart clinical indicator to set both CLININD and CLININD2
+48 SET CLININD=$PIECE(APSPRXO,"|",21)
+49 SET DONE=1
+50 ; Set up clinical indicator and REFREQ IEN into ORDIALOG
+51 FOR I=1:1
Begin DoDot:1
+52 IF $PIECE(CLININD,U,I)']""
QUIT
+53 SET ORDIALOG($$PTR^ORCD("OR GTX CLININD"),I)=$PIECE(CLININD,U,I)
End DoDot:1
IF DONE
QUIT
+54 SET ORDIALOG($$PTR^ORCD("OR GTX SSRREQIEN"),1)=ITEM
+55 SET DAW=$PIECE($GET(APSPRXO),"|",10)
+56 SET ORDIALOG($$PTR^ORCD("OR GTX DAW"),1)=DAW
+57 DO PREPPTXT^APSPES2("SSRTEXT",ITEM)
+58 SET I=0
FOR
SET I=$ORDER(SSRTEXT(I))
IF 'I
QUIT
Begin DoDot:1
+59 SET TXT=$GET(SSRTEXT(I))
+60 SET NSSRTXT(I,0)=TXT
End DoDot:1
+61 SET ORDIALOG($$PTR^ORCD("OR GTX SSREFREQ"),1)="NSSRTXT"
+62 SET ORDIALOG($$PTR^ORCD("OR GTX PHARMACY"),1)=PHARM
+63 SET SIGNOD=0
+64 IF '$ORDER(^APSPRREQ(ITEM,3,SIGNOD))
DO FULL^VALM1
WRITE !,"No signature, can not process entry."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+65 FOR
SET SIGNOD=$ORDER(^APSPRREQ(ITEM,3,SIGNOD))
IF 'SIGNOD
QUIT
Begin DoDot:1
+66 SET IENS=SIGNOD_","_IEN
+67 SET DAT("SIG",SIGNOD,0)=$GET(DATA(FIL3,IENS,.01,"E"))
End DoDot:1
+68 SET DIALOG=$ORDER(^ORD(101.41,"B","PSO OERR",0))
+69 IF 'DIALOG
DO FULL^VALM1
WRITE !,"Order dialog 'PSO OERR' could not be found."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+70 DO DLGDEF^ORWDX(.LIST,"PSO OERR")
+71 SET ORDIALOG=$ORDER(^ORD(101.41,"B","PSO OERR",0))
+72 FOR X="ORDERABLE","INSTR","ROUTE","SCHEDULE","QTY","SIG","DOSE","DRUG","CONJ","SUPPLY","REFILLS"
Begin DoDot:1
+73 SET Z=0
FOR
SET Z=$ORDER(LIST(Z))
IF 'Z
QUIT
Begin DoDot:2
+74 IF $PIECE($GET(LIST(Z)),U)=X
Begin DoDot:3
+75 SET DIEN=$PIECE(LIST(Z),U,2)
+76 IF X="SIG"
SET ORDIALOG(DIEN,1)="DAT(""SIG"")"
QUIT
+77 IF $ORDER(DAT(X,0))
Begin DoDot:4
+78 SET SN=0
FOR
SET SN=$ORDER(DAT(X,SN))
IF 'SN
QUIT
Begin DoDot:5
+79 SET ORDIALOG(DIEN,SN)=$GET(DAT(X,SN))
End DoDot:5
End DoDot:4
QUIT
+80 SET ORDIALOG(DIEN,1)=$GET(DAT(X))
End DoDot:3
End DoDot:2
End DoDot:1
+81 SET ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)="E"
+82 SET ORDIALOG($$PTR^ORCD("OR GTX URGENCY"),1)=$ORDER(^ORD(101.42,"B","ROUTINE",0))
+83 SET ORDIALOG($$PTR^ORCD("OR GTX LOCATION"),1)=LOC
+84 SET ORDCHK=$$CHKORD(.ORDIALOG,.MISLIST)
+85 IF 'ORDCHK
DO DISPMIS(.MISLIST)
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+86 ;IHS/MSC/JDS - 11/20/2010
IF '$$SCREEN^APSPMULT(+$GET(DAT("DRUG")),,1)
WRITE !,"Not a valid refill drug"
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+87 SET ORVP=DFN_";DPT("
SET ORNP=PROV
+88 DO SAVE^ORWD(.Y,DFN,PROV,$GET(LOC),DIALOG,"N",.ORDIALOG)
+89 IF $GET(Y)
SET NORIFN=$PIECE($PIECE($PIECE(Y(1),U),";"),"~",2)
+90 IF '$GET(NORIFN)
DO FULL^VALM1
WRITE !,"Order not filed.",!,"Check data and try again."
SET DIR(0)="FO"
SET DIR("A")="Press <Return> to continue"
DO ^DIR
DO BACK
QUIT
+91 DO EN^OCXOERR(DFN_U_+NORIFN_U_PROV_"^^^^^1")
+92 SET FDA(9009033.91,ITEM_",",.02)=NORIFN
+93 SET FDA(9009033.91,ITEM_",",.03)=1
+94 SET FDA(9009033.91,ITEM_",",.07)=$$NOW^XLFDT()
+95 DO FILE^DIE(,"FDA")
KILL FDA
+96 DO BACK
+97 QUIT
DISPHL7(PAT,QTY,PROV,DRUG,NOTE,STR,UNITS,ROUTE,NOUN,SCHARY,MEDUNITS,REFILLS,PHARM,SIG,ARY) ; Display HL7 data
+1 NEW LINE,K
+2 WRITE !!
+3 SET $PIECE(LINE,"-",80)=""
+4 WRITE LINE
+5 WRITE !," Displaying incoming HL7 data:",!
+6 WRITE !," Patient: "_PAT
+7 WRITE !," Provider: "_PROV
+8 WRITE !," Medication: "_DRUG
+9 WRITE !," SIG: "_SIG
+10 WRITE !," Note: "_NOTE
+11 WRITE !," Quantity: "_QTY
+12 WRITE !," Refills: "_REFILLS
+13 WRITE !," Pharmacy: "_PHARM
+14 WRITE !!," Dosing information: (multiple line items indicates complex dosing)"
+15 IF $DATA(SCHARY)
WRITE !,?3,"Units/Dose",?15,"Interval",?25,"Duration",?35,"Conjunction"
+16 FOR K=1:1
Begin DoDot:1
+17 IF $DATA(SCHARY(K))
WRITE !,?5,$PIECE(SCHARY(K),U),?15,$PIECE(SCHARY(K),U,2),?25,$PIECE(SCHARY(K),U,3),?35,$PIECE(SCHARY(K),U,4)
End DoDot:1
IF '$DATA(SCHARY(K))
QUIT
+18 WRITE !,LINE
+19 QUIT
+20 ;
+21 ;
CHKDEF(IEN,TEXT) ;
+1 NEW FOUND,X
+2 SET FOUND=0
+3 SET X=0
FOR
SET X=$ORDER(^APSPRREQ(ITEM,3,X))
IF 'X
QUIT
Begin DoDot:1
+4 IF $GET(^APSPRREQ(ITEM,3,X,0))=TEXT
SET FOUND=1
End DoDot:1
+5 QUIT FOUND
SELITEM() ;
+1 NEW MAX,PARAM,DPRMPT,ITEM,IEN
+2 SET MAX=$ORDER(^TMP("VALMAR",$JOB,VALMEVL,"IDX",""),-1)
+3 SET PARAM="NO^1:"_MAX
SET DPRMPT="Select Entry"
+4 ; Prompt for item to edit
+5 SET ITEM=$$DIR^APSPUTIL(PARAM,DPRMPT)
+6 IF 'ITEM
QUIT 0
+7 IF '$DATA(^TMP("VALMAR",$JOB,VALMEVL,"IDX",ITEM))
QUIT 0
+8 SET IEN=$ORDER(^TMP("VALMAR",$JOB,VALMEVL,"IDX",ITEM,0))
+9 QUIT IEN
PATNAME(PIDSEG) ;
+1 NEW PAT,PATLN,PATFN,PATNAME,PATMN
+2 SET PAT=$PIECE(PIDSEG,"|",6)
IF '$LENGTH(PAT)
QUIT ""
+3 SET PATLN=$PIECE(PAT,U)
SET PATFN=$PIECE(PAT,U,2)
SET PATMN=$PIECE(PAT,U,3)
+4 SET PATNAME=PATLN_","_PATFN_" "_PATMN
+5 QUIT PATNAME
BACK ;
+1 ;L -^APSPRREQ(ITEM)
+2 KILL @VALMAR
DO INIT
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
+6 ; Builds array of control data
BLDARY(FLDARY) ;
+1 NEW QUIT,TEXT
+2 SET QUIT=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET TEXT=$TEXT(FLDLST+I)
IF $PIECE(TEXT,";;",2)=""
SET QUIT=1
QUIT
+5 SET FLDARY(I)=$TEXT(FLDLST+I)
End DoDot:1
IF QUIT
QUIT
+6 QUIT
+7 ; Parameterized DIE call for top level field
PRMPT(FILE,IENS,FLD,DFT) ; PROMPT FIELD
+1 NEW DIE,DA,DR,Y,X
+2 SET DIE("NO^")="OUTOK"
+3 SET DIE=FILE
SET DA=IENS
SET DR=FLD_"//"_$SELECT($LENGTH($GET(DFT)):DFT,1:"")
DO ^DIE
+4 QUIT $DATA(Y)
+5 ;
+6 ;Parameterized DIE call for subfile
PRMPT2(FILE,TIEN,SIEN,FLD,NODE,DFT) ;
+1 NEW DIE,DA,DR,Y,X,DEL
+2 SET DEL=0
+3 SET DIE("NO^")="OUTOK"
+4 SET DIE="^APSPRREQ("_ITEM_","_NODE_","
SET DA(1)=TIEN
SET DA=SIEN
SET DR=FLD_"//"_$SELECT($DATA(DFT):DFT,1:"")
DO ^DIE
+5 IF '$DATA(DA)
SET DEL=1
+6 QUIT $DATA(Y)_"|"_DEL
+7 ;
GETIEN(FILE,PRMT,DEF,POP) ;
+1 NEW DIC,APSPD,Y
+2 SET POP=0
+3 IF '$DATA(DEF)
SET DEF=" "
+4 SET APSPD=$$GET1^DIQ(FILE,$$FIND1^DIC(FILE,,,DEF),.01)
+5 SET DIC=FILE
SET DIC(0)="AE"
SET DIC("A")=$GET(PRMT)
SET DIC("B")=APSPD
+6 DO ^DIC
+7 IF Y'>0
SET POP=1
+8 QUIT +Y
+9 ; Display missing data elements to user.
+10 ; input - MLIST (from CHKORD), passed by reference
DISPMIS(MLIST) ;
+1 NEW ITEM,LINE
+2 SET $PIECE(LINE,"-",80)=""
WRITE !!,LINE
+3 WRITE !,"The following items are not defined. This order can not be created."
+4 WRITE !,"Please correct these items and try again."
+5 SET ITEM=""
FOR
SET ITEM=$ORDER(MLIST(ITEM))
IF ITEM']""
QUIT
Begin DoDot:1
+6 WRITE !,ITEM
End DoDot:1
+7 WRITE !,LINE
+8 QUIT
+9 ; Input: OARY - ORDIALOG passed in by reference
+10 ; MLIST - List of data elements that are missing from the order (pass by ref.), returned to calling module
CHKORD(OARY,MLIST) ;
+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
REQFLDS ;
+1 ;;OR GTX ORDERABLE ITEM
+2 ;;OR GTX INSTRUCTIONS
+3 ;;OR GTX ROUTE
+4 ;;OR GTX SCHEDULE
+5 ;;OR GTX URGENCY
+6 ;;OR GTX ROUTING
+7 ;;OR GTX REFILLS
+8 ;;OR GTX DAYS SUPPLY
+9 ;;OR GTX PHARMACY
+10 ;;OR GTX DAW
+11 ;;OR GTX SSREFREQ
+12 ;;OR GTX SSRREQIEN
+13 ;;
+14 QUIT
