Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPESG2

APSPESG2.m

Go to the documentation of this file. 
  1. APSPESG2 ;IHS/MSC/PLS - SureScripts Refill Request;30-Jul-2013 18:59;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23, 2004;Build 40
  1.  Q
  1.  ;
  1. LOADRSP(LST,IEN) ;EP to return data
  1.  N ROOT,CHKDOSE,DOSE,INST,ILST,I,ID,DLG,VAL,J,LIST
  1.  K LST
  1.  I '$D(^APSPRREQ(IEN,4.5)) D
  1.  .D DLGDEF^ORWDX1(.LIST,"PSO OERR")
  1.  .S I=0 F  S I=$O(LIST(I)) Q:'I  D
  1.  ..I $P(LIST(I),U)="ORDERABLE" D
  1.  ...N ITM
  1.  ...S DLG=$P(LIST(I),U,2)
  1.  ...S ITM=$$GET1^DIQ(9009033.91,IEN,1.1,"I")
  1.  ...S LST(1)="~"_DLG_U_1_U_"ORDERABLE"
  1.  ...S LST(2)="i"_ITM,LST(3)="e"_$$GET1^DIQ(101.43,ITM,.01)
  1.  .;ADDED FROM PREVIOUS
  1.  .N ITEM,OI,EXT,INT,DATA
  1.  .S ILST=0
  1.  .D DLGDEF^ORWDX1(.LIST,"PSO OERR")
  1.  .D GETS^DIQ(9009033.91,IEN,".01:1.9;2*;3*;4.1;7.1","E","EXT")
  1.  .D GETS^DIQ(9009033.91,IEN,".01:1.9;2*;3*;4.1;7.1","I","INT")
  1.  .S ITEM="" F  S ITEM=$O(LIST(ITEM)) Q:'+ITEM  D
  1.  ..S DATA=$G(LIST(ITEM))
  1.  ..Q:DATA=""
  1.  ..S DLG=$P(DATA,U,2),INST=1,ID=$P(DATA,U,1)
  1.  ..I ID="ORDERABLE" D GET(1.1,DLG,INST,ID)
  1.  ..I ID="START" D NEW(DLG,INST,ID),VAL(0,0)
  1.  ..I ID="URGENCY" D NEW(DLG,INST,ID),VAL(9,"ROUTINE")
  1.  ..;I ID="DRUG" D GET(1.8,DLG,INST,ID)
  1.  ..I ID="PICKUP" D NEW(DLG,INST,ID) D
  1.  ...I $$ERXOI^APSPFNC6($$GET1^DIQ(9009033.91,IEN,1.1,"I"),2) D
  1.  ....D VAL("P","PRINT")
  1.  ...E  D VAL("E","ELECTRONIC")
  1.  ..I ID="QTY" D GET(1.4,DLG,INST,ID)
  1.  ..I ID="REFILLS" D GET(1.9,DLG,INST,ID)
  1.  ..I ID="SCHEDULE" D SUB(1.8,DLG,INST,ID)
  1.  ..I ID="INSTR" D INSTR(DLG,INST,ID)
  1.  ..I ID="ROUTE" D SUB(1.7,DLG,INST,ID)
  1.  ..I ID="DAW" D GET(1.12,DLG,INST,ID)
  1.  ..;I ID="DAYS" D SUB(4,DLG,INST,ID)
  1.  ..;I ID="CLININD" D NEW(DLG,INST,ID)
  1.  ..I ID="CLININD" D GET(7.1,DLG,INST,ID)
  1.  ..I ID="CLININD2" D NEW(DLG,INST,ID)
  1.  ..I ID="SNMDCNPTID" D NEW(DLG,INST,ID)
  1.  ..I ID="SSREQIEN" D NEW(DLG,INST,ID),VAL(IEN,IEN)
  1.  ..I ID="SSDENYRSN" D NEW(DLG,INST,ID)
  1.  ..;I ID="PHARMACY",'$$ERXOI^APSPFNC6($$GET1^DIQ(9009033.91,IEN,1.1,"I"),2) D GET(1.7,DLG,INST,ID)
  1.  ..I ID="PHARMACY" D GET(1.7,DLG,INST,ID)
  1.  ..I ID="STRENGTH" D NEW(DLG,INST,ID)
  1.  ..I ID="SIG" D SUB2(DLG,INST,ID)
  1.  ..I ID="CONJ" D SUB(1.6,DLG,INST,ID)
  1.  ..I ID="SUPPLY" D GET(1.5,DLG,INST,ID)
  1.  ..I ID="CMF" D NEW(DLG,INST,ID)
  1.  ..I ID="DOSE" D DOSE(DLG,INST,ID)
  1.  ..;I ID="PI" D PI(4.1,DLG,INST,ID)
  1.  ..I ID="COMMENT" D NP(4.1,DLG,INST,ID)
  1.  E  D
  1.  .S ROOT="^APSPRREQ("_+IEN_",4.5)"
  1.  .S (ILST,I)=0,CHKDOSE=$$CHKDOSES^ORWDX2()
  1.  .F  S I=$O(@ROOT@(I)) Q:I'>0  D
  1.  ..S DLG=$P(@ROOT@(I,0),U,2),INST=$P(^(0),U,3)
  1.  ..S ID=$P($G(^ORD(101.41,DLG,1)),U,3)
  1.  ..I '$L(ID) S ID="ID"_DLG
  1.  ..S VAL=$G(@ROOT@(I,1))
  1.  ..I $P($G(^ORD(101.41,DLG,0)),U)="OR GTX ADDITIVE" S ID="ADDITIVE"
  1.  ..S LST($$NXT)="~"_DLG_U_INST_U_ID
  1.  ..I $L(VAL) D
  1.  ...S LST($$NXT)="i"_VAL,LST($$NXT)="e"_$$EXTVAL^ORWDX2(VAL,DLG)
  1.  ...I CHKDOSE D DOSEINFO^ORWDX2
  1.  ..I $D(@ROOT@(I,2))>1 D
  1.  ...S J=0 F  S J=$O(@ROOT@(I,2,J)) Q:J'>0  D
  1.  ....S LST($$NXT())="t"_$G(@ROOT@(I,2,J,0))
  1.  .I CHKDOSE D FIXDOSES^ORWDX2
  1.  Q
  1. NEW(DLG,INST,ID) ;
  1.  S LST($$NXT)="~"_DLG_U_INST_U_ID
  1.  Q
  1. VAL(IVAL,EVAL) ;
  1.  I $L(IVAL) D
  1.  .S LST($$NXT)="i"_IVAL,LST($$NXT)="e"_EVAL
  1.  Q
  1. PI(FIELD,DLG,INST,ID) ;
  1.  N I,E
  1.  D NEW(DLG,INST,ID)
  1.  S I=$G(^APSPRREQ(IEN,FIELD))
  1.  S E=I
  1.  D VAL(I,E)
  1.  Q
  1. NP(FIELD,DLG,INST,ID) ;
  1.  N I,E
  1.  D NEW(DLG,INST,ID)
  1.  S I=$G(^APSPRREQ(IEN,FIELD))
  1.  S E=I
  1.  D VAL(I,E)
  1.  Q
  1. GET(FIELD,DLG,INST,ID) ;
  1.  N I,E
  1.  D NEW(DLG,INST,ID)
  1.  S I=$G(INT(9009033.91,IEN_",",FIELD,"I"))
  1.  S E=$G(EXT(9009033.91,IEN_",",FIELD,"E"))
  1.  I FIELD=1.9 D
  1.  .S I=$S(I>0:I-1,1:0),E=$S(E>0:E-1,1:0)
  1.  D VAL(I,E)
  1.  Q
  1. SUB(SFIELD,DLG,INST,ID) ;
  1.  N I,E,IENS,AIEN
  1.  S IENS=0 F  S IENS=$O(^APSPRREQ(IEN,2,IENS)) Q:'+IENS  D
  1.  .D NEW(DLG,IENS,ID)
  1.  .S AIEN=IENS_","_IEN_","
  1.  .S I=$G(INT(9009033.912,AIEN,SFIELD,"I"))
  1.  .S E=$G(EXT(9009033.912,AIEN,SFIELD,"E"))
  1.  .D VAL(I,E)
  1.  Q
  1. INSTR(DLG,INST,ID) ;Do instr
  1.  N I,E,IENS,AIEN
  1.  S IENS=0 F  S IENS=$O(^APSPRREQ(IEN,2,IENS)) Q:'+IENS  D
  1.  .D NEW(DLG,IENS,ID)
  1.  .S I=$P($G(^APSPRREQ(IEN,2,IENS,0)),"&",5)
  1.  .S E=$P($G(^APSPRREQ(IEN,2,IENS,0)),"&",5)
  1.  .D VAL(I,E)
  1. SUB2(DLG,INST,ID) ; Do sig
  1.  N SIG
  1.  D NEW(DLG,INST,ID)
  1.  S SIG=0 F  S SIG=$O(^APSPRREQ(IEN,3,SIG)) Q:'+SIG  D
  1.  .S LST($$NXT)="t"_$G(^APSPRREQ(IEN,3,SIG,0))
  1.  Q
  1. DOSE(DLG,INST,ID) ;Do dosing
  1.  N CHKDOSE,INSTR,DOSE,PSOI,DFN,CONJ,ORWDOSES,IENS
  1.  S DFN=$G(INT(9009033.91,IEN_",",1.2,"I"))
  1.  S FIELD=1.1
  1.  S OI=$G(INT(9009033.91,IEN_",",FIELD,"I"))
  1.  S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)
  1.  S IENS=0 F  S IENS=$O(^APSPRREQ(IEN,2,IENS)) Q:IENS=""  D
  1.  .D NEW(DLG,IENS,ID)
  1.  .S I=$G(^APSPRREQ(IEN,2,IENS,0))
  1.  .S E=$G(^APSPRREQ(IEN,2,IENS,0))
  1.  .D VAL(I,E)
  1.  ;D DOSE^PSSORUTL(.ORDOSE,PSOI,"O",DFN)
  1.  ;S CONJ=$P($G(ORDOSE("MISC")),U,3),ORWDOSES=0
  1.  ;S:$L(CONJ) CONJ=" "_CONJ_" " S:'$L(CONJ) CONJ=" "
  1.  ;S I=0 F  S I=$O(ORDOSE(I)) Q:I'>0  D
  1.  ;. S X=$$BLDDOSE^ORWDPS2(ORDOSE(I))
  1.  ;. S ILST=ILST+1
  1.  ;. S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4)
  1.  ;. S J=0 F  S J=$O(ORDOSE(I,J)) Q:J'>0  D
  1.  ;. . S X=$$BLDDOSE^ORWDPS2(ORDOSE(I,J))
  1.  ;. . S ILST=ILST+1
  1.  ;. . S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4)
  1.  Q
  1.  ;
  1. NXT() ; -- Gets index in array
  1.  S ILST=ILST+1
  1.  Q ILST
  1.  ;
  1.  ;Input parameters
  1.  ;IEN=Internal number from APAP REFILL REQUEST file
  1.  ;DFN=Patient IEN
  1.  ;ORNP=Provider IEN
  1.  ;ORL=IEN of location
  1.  ;DLG=Defaults to PSO OERR
  1.  ;STAT=Interval value of status
  1.  ; 2        PROCESSED - ACCEPTED
  1.  ; 3        PROCESSED - DENIED
  1.  ; 5        PROCESSED - DENIED (NEW RX)
  1.  ;LIST=Array of pieces to store similar to ORWDX SAVE
  1.  ;REASON=Reason for denial
  1. UPDATE(REC,IEN,DFN,ORNP,ORL,STAT,LIST,REASON,DLG) ;EP-
  1.  N IFN,ORDIALOG,ERR,NAME,FLD,FLD2,SUB
  1.  S REC=""
  1.  S DLG=$G(DLG,"PSO OERR")
  1.  S IFN=$O(^ORD(101.41,"B",DLG,""))
  1.  Q:'IFN
  1.  M ORDIALOG=LIST
  1.  D GETDLG1^ORCD(IFN)
  1.  S:STAT>-1 FDA(9009033.91,IEN_",",.03)=STAT
  1.  S FDA(9009033.91,IEN_",",.07)=$$NOW^XLFDT
  1.  S:DFN FDA(9009033.91,IEN_",",1.2)=DFN
  1.  S:ORNP FDA(9009033.91,IEN_",",1.3)=ORNP
  1.  S:ORL FDA(9009033.91,IEN_",",1.6)=ORL
  1.  S:$L($G(REASON)) FDA(9009033.91,IEN_",",4)=$G(REASON)
  1.  D RESPUPD(.ORDIALOG)
  1.  S FLD="" F  S FLD=$O(ORDIALOG(FLD)) Q:FLD=""  D
  1.  .S FLD2=+FLD
  1.  .I $D(ORDIALOG(FLD)) D
  1.  ..S NAME=$P($G(ORDIALOG(FLD2)),U,2)
  1.  ..I NAME="ORDERABLE" D TOP(1.1) Q
  1.  ..I NAME="QTY" D TOP(1.4) Q
  1.  ..I NAME="DRUG" D TOP(1.8) Q
  1.  ..I NAME="SUPPLY" D TOP(1.5) Q
  1.  ..I NAME="DAW" D TOP(1.12) Q
  1.  ..I NAME="PHARMACY" D TOP(1.7) Q
  1.  ..I NAME="REFILLS" D FILL(1.9) Q
  1.  ..I NAME="CLININD" D TOP(7.1) Q
  1.  ..I NAME="CLININD2" D TOP(7.2) Q
  1.  ..I NAME="SNMDCNPTID" D TOP(7.3) Q
  1.  ..;I NAME="PI" D TOP(4.1) Q
  1.  ..I NAME="PI" D PI2(FLD,1) Q
  1.  ..S SUB="" F  S SUB=$O(LIST(FLD,SUB)) Q:SUB=""  D
  1.  ...I NAME="ROUTE" D SUBFLD(1.7,SUB)
  1.  ...I NAME="SCHEDULE" D SUBFLD(1.8,SUB)
  1.  ...I NAME="DOSE" D DOSAGE(SUB)
  1.  ...I NAME="SIG" D SIG(SUB)
  1.  ;When all finished file the data
  1.  D FILE^DIE("","FDA","ERR")
  1.  I $D(ERR)>0 S REC="0^Unable to Update Record" Q
  1.  E  S REC=1
  1.  K FDA,ERR
  1.  Q
  1.  ;Place responses into multiple
  1. RESPUPD(ORDIALOG) ;EP- Copied from RESPONSE^ORCSAVE
  1.  N CNT,PROMPT,ITM,TYPE,VALUE
  1.  K ^APSPRREQ(IEN,4.5)
  1.  S (PROMPT,CNT)=0 F  S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0  D
  1.  .S ITM=$G(ORDIALOG(PROMPT)) Q:'ITM
  1.  .S TYPE=$E($G(ORDIALOG(PROMPT,0))) Q:'$L(TYPE)
  1.  .S INST=0 F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0  D
  1.  ..S VALUE=$G(ORDIALOG(PROMPT,INST)) Q:VALUE=""  S CNT=CNT+1
  1.  ..S ^APSPRREQ(IEN,4.5,CNT,0)=+ITM_U_PROMPT_U_INST_U_$P(ITM,U,2)
  1.  ..S:$L($P(ITM,U,2)) ^APSPRREQ(IEN,4.5,"ID",$P(ITM,U,2),CNT)=""
  1.  ..I VALUE<1,TYPE="N" S VALUE=0_+VALUE I VALUE="00" S VALUE=0
  1.  ..S:TYPE'="W" ^APSPRREQ(IEN,4.5,CNT,1)=VALUE
  1.  ..M:TYPE="W" ^APSPRREQ(IEN,4.5,CNT,2)=@VALUE  ; array root
  1.  S ^APSPRREQ(IEN,4.5,0)="^9009033.913A^"_CNT_U_CNT
  1.  Q
  1. TOP(FIELD) ;Set top fields for update
  1.  N DATA
  1.  S DATA=$G(LIST(FLD,"1"))
  1.  S FDA(9009033.91,IEN_",",FIELD)=DATA
  1.  Q
  1. FILL(FIELD) ;Set refills
  1.  ;Set sub fields for update
  1.  N DATA
  1.  S DATA=$G(LIST(FLD,"1"))+1
  1.  S FDA(9009033.91,IEN_",",FIELD)=DATA
  1.  Q
  1. SUBFLD(FIELD,SUB) N DATA,AIEN
  1.  S AIEN=+SUB_","_IEN_","
  1.  S DATA=$G(LIST(FLD,SUB))
  1.  S FDA(9009033.912,AIEN,FIELD)=DATA
  1.  Q
  1. DOSAGE(SUB) ;Set dose fields
  1.  N DATA,AIEN,UNITS,UIEN
  1.  S DATA=$G(LIST(FLD,SUB))
  1.  S AIEN=+SUB_","_IEN_","
  1.  S FDA(9009033.912,AIEN,.01)=DATA
  1.  S FDA(9009033.912,AIEN,1.1)=$P(DATA,"&",1)
  1.  S FDA(9009033.912,AIEN,1.2)=$P(DATA,"&",3)
  1.  S UNITS=$P(DATA,"&",2)
  1.  I UNITS'="" D
  1.  .S UIEN="" S UIEN=$O(^PS(50.607,"B",UNITS,UIEN))
  1.  .I +UIEN S FDA(9009033.912,AIEN,1.3)=UIEN
  1.  S FDA(9009033.912,AIEN,1.4)=$P(DATA,"&",4)
  1.  S FDA(9009033.912,AIEN,1.9)="TAKE"
  1.  Q
  1. SIG(SUB) ;Get sig segment
  1.  N X,DATA,ARRAY,CNT,DA,DIK,ERR,FDA2
  1.  S CNT=0
  1.  S DATA=$G(LIST(FLD,SUB))
  1.  S X=9009033.913 D DELSF(X,+IEN_",")
  1.  S X=0 S X=$O(LIST("WP",FLD,SUB,X)) Q:X=""  D
  1.  .S AIEN="+1,"_IEN_","
  1.  .S FDA2(9009033.913,AIEN,.01)=$G(LIST("WP",FLD,SUB,X,0))
  1.  D UPDATE^DIE(,"FDA2","AIEN","ERR")
  1.  I $D(ERR)>0 S REC="0^Unable to update sig"
  1.  Q
  1. PI2(FLD,SUB) ;EP-
  1.  N X,DATA,TXT
  1.  S DATA=$G(LIST(FLD,SUB))
  1.  S TXT=""
  1.  S X=0 S X=$O(LIST("WP",FLD,SUB,X)) Q:X=""  D
  1.  .S TXT=TXT_$G(LIST("WP",FLD,SUB,X,0))
  1.  S FDA(9009033.91,IEN_",",4.1)=TXT
  1.  Q
  1. DELSF(SFN,IEN) ;
  1.  N DIK,DA,LP,GBL,IEN2
  1.  S IEN2=","_IEN,DIK=$$ROOT^DILFD(SFN,IEN2),GBL=$$ROOT^DILFD(SFN,IEN2,1),DA=0
  1.  F  S DA=$O(@GBL@(DA)),DA(1)=+IEN Q:'DA  D ^DIK
  1.  Q
  1.  ; Process a mapped SureScripts Refill Request
  1. PROCESS(DATA,IEN) ;EP-
  1.  S DATA=$$CREATE(IEN)
  1.  Q
  1.  ;
  1. CREATE(ITEM) ; Create new OE/RR order
  1.  N HLMSG,APSPMSH,APSPPID,APSPORC,APSPRXO,APSPRXE,IEN,IENS,ID,IDIEN,DAT,DFN,PROV,UNITS,NOUN
  1.  N DUR,CONJ,VERB,SIGNOD,INSTNOD,SIG,DUPD,X,Z,ORDIALOG,NORIFN,ORVP,DIALOG,ORNP,STATUS,APSPRXO
  1.  N APSPRXE,APSPRXR,APSPORC,APSPPID,DIEN,IDIEN,DUOUT,FIL2,FIL3,FIL,LIST,LOC,ROUTE,CNT,DIR,PHARM
  1.  N CLININD,OPSIEN,SSRTEXT,DAW,MISLIST,REFIL,HLDATA,DAW,SNMDCID
  1.  N DATA,DRUG,FCNT,NOD0,NOD1,TXT,NSSRTXT
  1.  S FIL=9009033.91,FIL2=9009033.912,FIL3=9009033.913
  1.  ; set up hl7 variables
  1.  S NOD0=$G(^APSPRREQ(ITEM,0))
  1.  S NOD1=$G(^APSPRREQ(ITEM,1))
  1.  Q:(NOD0="")!(NOD1="") "1 ^Entry not available"
  1.  S HLMSG=$$GHLDAT(ITEM) D SHLVARS
  1.  ; get data from APSP REFILL REQUESTS FILE
  1.  D PREPPTXT^APSPES2("PTXT",ITEM)
  1.  D GETS^DIQ(FIL,ITEM,"**","IE","DATA")
  1.  S IEN=ITEM_","
  1.  S LOC=$P(NOD1,U,6)
  1.  S PHARM=$P(NOD1,U,7)
  1.  S DRUG=$P(NOD1,U,8)
  1.  S FCNT=$P(NOD1,U,9)
  1.  S DAW=$P(NOD1,U,12)
  1.  S DFN=$G(DATA(FIL,IEN,1.2,"I"))
  1.  S PROV=$G(DATA(FIL,IEN,1.3,"I"))
  1.  ;S DAT("REFILLS")=$S(FCNT>0:FCNT-1,1:0)
  1.  S ORDIALOG($$PTR^ORCD("OR GTX SSRREQIEN"),1)=ITEM
  1.  D PREPPTXT^APSPES2("SSRTEXT",ITEM)
  1.  S I=0 F  S I=$O(SSRTEXT(I)) Q:'I  D
  1.  .S TXT=$G(SSRTEXT(I))
  1.  .S NSSRTXT(I,0)=TXT
  1.  S ORDIALOG($$PTR^ORCD("OR GTX SSREFREQ"),1)="NSSRTXT"
  1.  D BLDRSP(.ORDIALOG,ITEM)
  1.  S DIALOG=$O(^ORD(101.41,"B","PSO OERR",0))
  1.  S ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1)=DRUG
  1.  S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)="E"
  1.  S ORDIALOG($$PTR^ORCD("OR GTX URGENCY"),1)=$O(^ORD(101.42,"B","ROUTINE",0))
  1.  S ORDIALOG($$PTR^ORCD("OR GTX LOCATION"),1)=LOC
  1.  S ORDIALOG($$PTR^ORCD("OR GTX DAW"),1)=DAW
  1.  S ORVP=DFN_";DPT(",ORNP=PROV
  1.  D SAVE^ORWD(.Y,DFN,PROV,$G(LOC),DIALOG,"N",.ORDIALOG)
  1.  I $G(Y) S NORIFN=$P($P($P(Y(1),U),";"),"~",2)
  1.  I '$G(NORIFN) Q "1^Order not filed. Check data and try again."
  1.  D EN^OCXOERR(DFN_U_+NORIFN_U_PROV_"^^^^^1")
  1.  S FDA(9009033.91,ITEM_",",.02)=NORIFN
  1.  S FDA(9009033.91,ITEM_",",.03)=1
  1.  S FDA(9009033.91,ITEM_",",.07)=$$NOW^XLFDT()
  1.  S FDA(9009033.91,ITEM_",",1.11)=2
  1.  D FILE^DIE(,"FDA") K FDA
  1.  Q "0^Order created."
  1.  ; Display missing data elements to user.
  1.  ; input - MLIST (from CHKORD), passed by reference
  1. DISPMIS(MLIST) ;
  1.  N ITEM,LINE
  1.  S $P(LINE,"-",80)="" W !!,LINE
  1.  W !,"The following items are not defined. This order can not be created."
  1.  W !,"Please correct these items and try again."
  1.  S ITEM="" F  S ITEM=$O(MLIST(ITEM)) Q:ITEM']""  D
  1.  .W !,ITEM
  1.  W !,LINE
  1.  Q
  1.  ; Input: OARY - ORDIALOG passed in by reference
  1.  ;        MLIST - List of data elements that are missing from the order (pass by ref.), returned to calling module
  1. CHKORD(OARY,MLIST) ;
  1.  N STAT,I,DONE,CHKITEM,CHKIEN
  1.  S STAT=1,DONE=0
  1.  F I=1:1 D  Q:DONE
  1.  .S CHKITEM=$P($T(REQFLDS+I),";;",2)
  1.  .I '$L(CHKITEM) S DONE=1 Q
  1.  .S CHKIEN=$O(^ORD(101.41,"B",CHKITEM,0))
  1.  .I 'CHKIEN Q
  1.  .; if the array item doesn't exist, place it in the 'missing' array and set stat to zero
  1.  .I '$D(OARY(CHKIEN)) S MLIST(CHKITEM)=CHKIEN,STAT=0 Q
  1.  .; if the array item exists, but there is no data populated, set the 'missing' array item and stat to zero
  1.  .I $D(OARY(CHKIEN)),'$L($G(OARY(CHKIEN,1))) S MLIST(CHKITEM)=CHKIEN,STAT=0 Q
  1.  Q STAT
  1.  ;
  1. GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
  1.  N HLMSG
  1.  S HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
  1.  Q HLMSG
  1.  ;
  1. SHLVARS ; Set up HL segment data
  1.  N SEGTYP,VAR
  1.  F SEGTYP="MSH","PID","ORC","RXO","RXE","RXR" S VAR="APSP"_SEGTYP,@VAR="",@VAR=$$GETSEG(.HLDATA,SEGTYP)
  1.  Q
  1.  ; Input:  DATA - HL7 data from APSP REFILL REQUEST file
  1.  ;         TYPE - Message segment requested
  1. GETSEG(DATA,TYPE) ;
  1.  N X,RET,Q
  1.  S RET="",(X,Q)=0 F  S X=$O(DATA(X)) Q:'X!(Q)  D
  1.  .S DAT=$G(DATA(X)) I DAT="" S RET="" Q
  1.  .I $P(DAT,"|")=TYPE S RET=DAT,Q=1 Q
  1.  Q RET
  1.  ; Build ORDIALOG array for creation of order
  1. BLDRSP(ORDIALOG,IEN) ;EP-
  1.  N LP,LP1,NOD0,INST,ITM,VAL
  1.  S LP=0 F  S LP=$O(^APSPRREQ(IEN,4.5,LP)) Q:'LP  D
  1.  .S NOD0=^APSPRREQ(IEN,4.5,LP,0)
  1.  .S ITM=$P(NOD0,U,2)
  1.  .S INST=$P(NOD0,U,3)
  1.  .S VAL=$G(^APSPRREQ(IEN,4.5,LP,1))
  1.  .I $D(^APSPRREQ(IEN,4.5,LP,2))>1 D
  1.  ..S LP1=0 F  S LP1=$O(^APSPRREQ(IEN,4.5,LP,2,LP1)) Q:'LP1  D
  1.  ...S ORDIALOG("WP",ITM,INST,LP1,0)=^APSPRREQ(IEN,4.5,LP,2,LP1,0)
  1.  ..S ORDIALOG(ITM,INST)="ORDIALOG(""WP"","_ITM_","_INST_")"
  1.  .E  D
  1.  ..S ORDIALOG(ITM,INST)=VAL
  1.  Q
  1. REQFLDS ;
  1.  ;;OR GTX ORDERABLE ITEM
  1.  ;;OR GTX INSTRUCTIONS
  1.  ;;OR GTX ROUTE
  1.  ;;OR GTX SCHEDULE
  1.  ;;OR GTX URGENCY
  1.  ;;OR GTX ROUTING
  1.  ;;OR GTX REFILLS
  1.  ;;OR GTX DAYS SUPPLY
  1.  ;;OR GTX PHARMACY
  1.  ;;OR GTX DAW
  1.  ;;OR GTX SSREFREQ
  1.  ;;OR GTX SSRREQIEN
  1.  ;;
  1.  Q