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

APSPESLP.m

Go to the documentation of this file. 
  1. 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
  1.  ; IHS/MSC/MGH Added middle name for patch 1016
  1. EN ; -- main entry point for APSP LM REFILL REQUEST
  1.  D:'$D(PSOPAR) ^PSOLSET   ;P1013
  1.  D EN^VALM("APSP LM REFILL REQUEST")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  N LINE,MSGID,IEN,SEG,HLDATA,APSPMSH,APSPPID,APSPORC,APSPRX0,APSPRXE,DRUG,PAT,PATLN,PATFN,LINEVAR,ITMDATE
  1.  N PATNAME,STAT
  1.  S VALMCNT=0
  1.  S (IEN,LINE)=0 F  S IEN=$O(^APSPRREQ(IEN)) Q:'IEN  D
  1.  .; do not display if the status is 'processed', there is an OERR order number, or the HL7 data is misisng
  1.  .I $P(^APSPRREQ(IEN,0),U,2)!('$O(^APSPRREQ(IEN,5,0))) Q
  1.  .S STAT=+$$GET1^DIQ(9009033.91,IEN,.03,"I") I "1235"[STAT Q
  1.  .S MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E"),HLMSG=$$GHLDAT(IEN)
  1.  .D SHLVARS
  1.  .S PATNAME=$$PATNAME(APSPPID)
  1.  .S DRUG=$P($P(APSPRXO,"|",2),U,2)
  1.  .S ITMDATE=$$GET1^DIQ(9009033.91,IEN,.04,"I")
  1.  .S ITMDATE=$$FMTE^XLFDT($P(ITMDATE,"."),"5Z")
  1.  .; Set up record
  1.  .S LINE=LINE+1,VALMCNT=VALMCNT+1
  1.  .S LINEVAR=""
  1.  .S LINEVAR=$$SETFLD^VALM1(LINE_".",LINEVAR,"ITEM")
  1.  .S LINEVAR=$$SETFLD^VALM1(PATNAME,LINEVAR,"PATIENT")
  1.  .S LINEVAR=$$SETFLD^VALM1(DRUG,LINEVAR,"DRUG")
  1.  .S LINEVAR=$$SETFLD^VALM1(MSGID,LINEVAR,"MSGID")
  1.  .S LINEVAR=$$SETFLD^VALM1(ITMDATE,LINEVAR,"DATE")
  1.  .D SET^VALM10(LINE,LINEVAR,IEN)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  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="" S @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.  ;
  1. CREATE ; Create new OE/RR order
  1.  N ITEM,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
  1.  ; item selection
  1.  I '$O(@VALMAR@(0)) D BACK Q
  1.  S ITEM=$$SELITEM() I 'ITEM!(ITEM["^") D BACK Q
  1.  S FIL=9009033.91,FIL2=9009033.912,FIL3=9009033.913
  1.  ; set up hl7 variables
  1.  S HLMSG=$$GHLDAT(ITEM) D SHLVARS
  1.  ; get data from APSP REFILL REQUESTS FILE
  1.  D PREPPTXT^APSPES2("PTXT",ITEM)
  1.  I $D(PTXT) D
  1.  .S $P(LINE,"-",80)="" W !,LINE,!,"Displaying order information"
  1.  .D FULL^VALM1
  1.  .S I=0 F  S I=$O(PTXT(I)) Q:'I  W !,PTXT(I)
  1.  .W !,LINE
  1.  S CHKPROC=$$DIRYN^APSPUTIL("Are you sure you wish to create this order?","YES",,.POP) I POP D BACK Q
  1.  D GETS^DIQ(9009033.91,ITEM,"**","IE","DATA")
  1.  S IEN=ITEM_","
  1.  ; quit if status is 'PROCESSED' or 'PROCESSING'
  1.  S STATUS=+$G(DATA(FIL,IEN,.03,"I")) I "235"[STATUS D BACK Q
  1.  S LOC=$$GET1^DIQ(9009033.91,ITEM,1.6,"I")
  1.  S PHARM=$$GET1^DIQ(9009033.91,ITEM,1.7,"I")
  1.  ; Get the orderable item
  1.  S DAT("ORDERABLE")=$G(DATA(FIL,IEN,1.1,"I"))
  1.  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
  1.  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
  1.  ; get the IEN and try to locate the drug from ^PSDRUG
  1.  S ID=$$GET1^DIQ(101.43,DAT("ORDERABLE"),2,"E"),IDIEN=$P(ID,";"),DAT("DRUG")=$O(^PSDRUG("ASP",IDIEN,0))
  1.  S DFN=$G(DATA(FIL,IEN,1.2,"I")),PROV=$G(DATA(FIL,IEN,1.3,"I"))
  1.  S DAT("QTY")=+$G(DATA(FIL,IEN,1.4,"E")),DAT("SUPPLY")=$G(DATA(FIL,IEN,1.5,"E"))
  1.  S INSTNOD=$O(^APSPRREQ(ITEM,2,0))
  1.  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
  1.  ; Get all possible doses
  1.  S INST=0,CNT=1
  1.  F  S INST=$O(^APSPRREQ(ITEM,2,INST)) Q:'INST  D
  1.  .S IENS=INST_","_IEN
  1.  .S (DAT("DOSE",CNT),DAT("INSTR",CNT),DAT("STRENGTH",CNT))=$G(DATA(FIL2,IENS,.01,"E")),DUPD=$G(DATA(FIL2,IENS,1,"E"))
  1.  .S UNITS=$G(DATA(FIL2,IENS,2,"I"))
  1.  .S NOUN=$G(DATA(FIL2,IENS,3,"E")),DUR=$G(DATA(FIL2,IENS,4,"E")),DAT("CONJ")=$G(DATA(FIL2,IENS,5,"I"))
  1.  .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"))
  1.  .S CNT=CNT+1
  1.  ;
  1.  S DAT("REFILLS")=0
  1.  ; Get clinical indicator and build array for the data element. This field can be a multiple.
  1.  ; TODO - parse apart clinical indicator to set both CLININD and CLININD2
  1.  S CLININD=$P(APSPRXO,"|",21)
  1.  S DONE=1
  1.  ; Set up clinical indicator and REFREQ IEN into ORDIALOG
  1.  F I=1:1  D  Q:DONE
  1.  .I $P(CLININD,U,I)']"" Q
  1.  .S ORDIALOG($$PTR^ORCD("OR GTX CLININD"),I)=$P(CLININD,U,I)
  1.  S ORDIALOG($$PTR^ORCD("OR GTX SSRREQIEN"),1)=ITEM
  1.  S DAW=$P($G(APSPRXO),"|",10)
  1.  S ORDIALOG($$PTR^ORCD("OR GTX DAW"),1)=DAW
  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.  S ORDIALOG($$PTR^ORCD("OR GTX PHARMACY"),1)=PHARM
  1.  S SIGNOD=0
  1.  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
  1.  F  S SIGNOD=$O(^APSPRREQ(ITEM,3,SIGNOD)) Q:'SIGNOD  D
  1.  .S IENS=SIGNOD_","_IEN
  1.  .S DAT("SIG",SIGNOD,0)=$G(DATA(FIL3,IENS,.01,"E"))
  1.  S DIALOG=$O(^ORD(101.41,"B","PSO OERR",0))
  1.  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
  1.  D DLGDEF^ORWDX(.LIST,"PSO OERR")
  1.  S ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0))
  1.  F X="ORDERABLE","INSTR","ROUTE","SCHEDULE","QTY","SIG","DOSE","DRUG","CONJ","SUPPLY","REFILLS" D
  1.  .S Z=0 F  S Z=$O(LIST(Z)) Q:'Z  D
  1.  ..I $P($G(LIST(Z)),U)=X D
  1.  ...S DIEN=$P(LIST(Z),U,2)
  1.  ...I X="SIG" S ORDIALOG(DIEN,1)="DAT(""SIG"")" Q
  1.  ...I $O(DAT(X,0)) D  Q
  1.  ....S SN=0 F  S SN=$O(DAT(X,SN)) Q:'SN  D
  1.  .....S ORDIALOG(DIEN,SN)=$G(DAT(X,SN))
  1.  ...S ORDIALOG(DIEN,1)=$G(DAT(X))
  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 ORDCHK=$$CHKORD(.ORDIALOG,.MISLIST)
  1.  I 'ORDCHK D DISPMIS(.MISLIST) S DIR(0)="FO",DIR("A")="Press <Return> to continue" D ^DIR,BACK Q
  1.  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
  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) 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
  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.  D FILE^DIE(,"FDA") K FDA
  1.  D BACK
  1.  Q
  1. DISPHL7(PAT,QTY,PROV,DRUG,NOTE,STR,UNITS,ROUTE,NOUN,SCHARY,MEDUNITS,REFILLS,PHARM,SIG,ARY) ; Display HL7 data
  1.  N LINE,K
  1.  W !!
  1.  S $P(LINE,"-",80)=""
  1.  W LINE
  1.  W !,"   Displaying incoming HL7 data:",!
  1.  W !,"                   Patient: "_PAT
  1.  W !,"                  Provider: "_PROV
  1.  W !,"                Medication: "_DRUG
  1.  W !,"                       SIG: "_SIG
  1.  W !,"                      Note: "_NOTE
  1.  W !,"                  Quantity: "_QTY
  1.  W !,"                   Refills: "_REFILLS
  1.  W !,"                  Pharmacy: "_PHARM
  1.  W !!,"  Dosing information: (multiple line items indicates complex dosing)"
  1.  W:$D(SCHARY) !,?3,"Units/Dose",?15,"Interval",?25,"Duration",?35,"Conjunction"
  1.  F K=1:1 D  Q:'$D(SCHARY(K))
  1.  .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)
  1.  W !,LINE
  1.  Q
  1.  ;
  1.  ;
  1. CHKDEF(IEN,TEXT) ;
  1.  N FOUND,X
  1.  S FOUND=0
  1.  S X=0 F  S X=$O(^APSPRREQ(ITEM,3,X)) Q:'X  D
  1.  .I $G(^APSPRREQ(ITEM,3,X,0))=TEXT S FOUND=1
  1.  Q FOUND
  1. SELITEM() ;
  1.  N MAX,PARAM,DPRMPT,ITEM,IEN
  1.  S MAX=$O(^TMP("VALMAR",$J,VALMEVL,"IDX",""),-1)
  1.  S PARAM="NO^1:"_MAX,DPRMPT="Select Entry"
  1.  ; Prompt for item to edit
  1.  S ITEM=$$DIR^APSPUTIL(PARAM,DPRMPT)
  1.  I 'ITEM Q 0
  1.  I '$D(^TMP("VALMAR",$J,VALMEVL,"IDX",ITEM)) Q 0
  1.  S IEN=$O(^TMP("VALMAR",$J,VALMEVL,"IDX",ITEM,0))
  1.  Q IEN
  1. PATNAME(PIDSEG) ;
  1.  N PAT,PATLN,PATFN,PATNAME,PATMN
  1.  S PAT=$P(PIDSEG,"|",6) I '$L(PAT) Q ""
  1.  S PATLN=$P(PAT,U),PATFN=$P(PAT,U,2),PATMN=$P(PAT,U,3)
  1.  S PATNAME=PATLN_","_PATFN_" "_PATMN
  1.  Q PATNAME
  1. BACK ;
  1.  ;L -^APSPRREQ(ITEM)
  1.  K @VALMAR D INIT
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ; Builds array of control data
  1. BLDARY(FLDARY) ;
  1.  N QUIT,TEXT
  1.  S QUIT=0
  1.  F I=1:1 D  Q:QUIT
  1.  .S TEXT=$T(FLDLST+I) I $P(TEXT,";;",2)="" S QUIT=1 Q
  1.  .S FLDARY(I)=$T(FLDLST+I)
  1.  Q
  1.  ; Parameterized DIE call for top level field
  1. PRMPT(FILE,IENS,FLD,DFT) ; PROMPT FIELD
  1.  N DIE,DA,DR,Y,X
  1.  S DIE("NO^")="OUTOK"
  1.  S DIE=FILE,DA=IENS,DR=FLD_"//"_$S($L($G(DFT)):DFT,1:"") D ^DIE
  1.  Q $D(Y)
  1.  ;
  1.  ;Parameterized DIE call for subfile
  1. PRMPT2(FILE,TIEN,SIEN,FLD,NODE,DFT) ;
  1.  N DIE,DA,DR,Y,X,DEL
  1.  S DEL=0
  1.  S DIE("NO^")="OUTOK"
  1.  S DIE="^APSPRREQ("_ITEM_","_NODE_",",DA(1)=TIEN,DA=SIEN,DR=FLD_"//"_$S($D(DFT):DFT,1:"") D ^DIE
  1.  I '$D(DA) S DEL=1
  1.  Q $D(Y)_"|"_DEL
  1.  ;
  1. GETIEN(FILE,PRMT,DEF,POP) ;
  1.  N DIC,APSPD,Y
  1.  S POP=0
  1.  I '$D(DEF) S DEF=" "
  1.  S APSPD=$$GET1^DIQ(FILE,$$FIND1^DIC(FILE,,,DEF),.01)
  1.  S DIC=FILE,DIC(0)="AE",DIC("A")=$G(PRMT),DIC("B")=APSPD
  1.  D ^DIC
  1.  S:Y'>0 POP=1
  1.  Q +Y
  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. 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