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

ORDV06D.m

Go to the documentation of this file.
  1. ORDV06D ; SLC/JAS - OE/RR Report Extracts ;Oct 23, 2020@12:12:49
  1. ;;3.0;ORDER ENTRY RESULTS REPORTING;**539**;Dec 17, 1997;Build 41
  1. ;
  1. ;Pharmacy Extracts for CPRS Active Meds w/ Allergies Report
  1. ;Copied from ORDV06B and modified to specific report needs
  1. ;
  1. ; DBIA 3239 ^PSSUTIL1
  1. ; DBIA 2400 ^PSOORRL
  1. ; DBIA 10112 $$SITE^VASITE
  1. ; DBIA 3486 GCPR^OMGCOAS1
  1. ; DBIA 2378 ORCHK2^GMRAOR
  1. ;
  1. RXACT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All Active Patient Meds
  1. ;Call to PSOORRL
  1. I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
  1. . D GCPR^OMGCOAS1(DFN,"RXOP",ORDBEG,ORDEND,9999)
  1. ;
  1. N ORRXSTAT,GO
  1. Q:'$L(OREXT)
  1. S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
  1. Q:'$L($T(@GO))
  1. S ORRXSTAT=""
  1. D GETMED
  1. Q
  1. IN ;Setup and call to Pharmacy API
  1. ;LST(i)=
  1. ;LST(i) flags: "~" Start of new record, "/" Continuation line (concatination with Line feed CRLF)
  1. ;
  1. ;{ 1 2 3 4 5 6 7 8 9 10 11 16
  1. ;{ Pieces: Typ^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID^Status^LastFill^...^StartDt^ }
  1. ;If $P($P(X,"^",2),";",2)= "I" or "C" then Inpatient=TRUE
  1. ;If $P(X,"^",1)="~NV" then NonVAMed=TRUE and Instruct="Non-VA "_Instruct
  1. ;If $E($P(X,"^",1),1,2)="t\" then this is a comment, strip off the 1st character (t) and concatenate to other text
  1. ;Location := $P($P(X,U,1),":",2);
  1. K ^TMP("PS",$J),^TMP("ORACT",$J),^TMP("ORPS",$J)
  1. N ORBEG,OREND,ERROR,ORCTX,ORVIEW
  1. S (ORBEG,OREND,ORCTX)=""
  1. S ORVIEW=3 I $G(ORDEND)="" S ORDEND=DT
  1. S ORBEG=$S($G(ORDBEG):ORDBEG,1:$$DT^ORWPS("T-50000")),OREND=$S(ORDEND<DT:ORDEND,1:$$DT^ORWPS("T+3000"))
  1. D OCL^PSOORRL(DFN,$$DT^ORWPS("T-50000"),$$DT^ORWPS("T+3000"),ORVIEW)
  1. N ITMP,FIELDS,INSTRUCT,COMMENTS,REASON,NVSDT,TYPE,ILST,J,SORTDT,STOPDT
  1. S ILST=0,ITMP=""
  1. F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D
  1. . K INSTRUCT,COMMENTS,REASON,ORIFN
  1. . K ^TMP("ORACT",$J,"COMMENTS")
  1. . S COMMENTS="^TMP(""ORACT"",$J,""COMMENTS"")"
  1. . S (INSTRUCT,@COMMENTS,STOPDT)="",FIELDS=^TMP("PS",$J,ITMP,0)
  1. . I $P(FIELDS,"^",9)["DISCONTINUED"!($P(FIELDS,"^",9)["EXPIRED")!($P(FIELDS,"^",9)["CANCELLED") Q
  1. . S $P(FIELDS,"^",17)=$P($G(^TMP("PS",$J,ITMP,"P",0)),"^",2) ;Provider
  1. . S SORTDT=$S($L($P(FIELDS,"^",10)):$P(FIELDS,"^",10),1:$P(FIELDS,"^",15)) ;Date Priority: 1)Last Fill Date, 2)Issue/Start Date, 3)Order Date
  1. . I 'SORTDT D ;If pharmacy API doesn't screen out data within selected date range, check CPRS OrderDate and screen out as appropriate
  1. .. K ^TMP("ORXPS",$J) M ^TMP("ORXPS",$J)=^TMP("PS",$J)
  1. .. D OEL^PSOORRL(DFN,$P(FIELDS,"^")) ;This API uses same ^TMP("PS" global
  1. .. S ORIFN=+$P(^TMP("PS",$J,0),"^",11) I ORIFN S SORTDT=$P(^OR(100,ORIFN,0),"^",7),STOPDT=$P(^(0),"^",9)
  1. .. M ^TMP("PS",$J)=^TMP("ORXPS",$J) K ^TMP("ORXPS",$J)
  1. . S TYPE=$S($P($P(FIELDS,U),";",2)="O":"OP",1:"UD")
  1. . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S TYPE="CP"
  1. . N LOC,LOCEX S (LOC,LOCEX)=""
  1. . I TYPE="CP" S LOC=$G(^TMP("PS",$J,ITMP,"CLINIC",0))
  1. . S:LOC LOCEX=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO
  1. . I TYPE="OP",$P(FIELDS,";")["N" S TYPE="NV" ;non-VA med
  1. . ;Next line excludes any data where (ExpirationDate, LastFill Date, StartDate or OrderDate) is outside of selected date range for everything except non-VAmeds.
  1. . I TYPE'="NV",SORTDT<ORBEG!(SORTDT>OREND),($P(FIELDS,"^",4)<ORBEG!($P(FIELDS,"^",4)>OREND)),($P(FIELDS,"^",10)<ORBEG!($P(FIELDS,"^",10)>OREND)),($P(FIELDS,"^",15)<ORBEG!($P(FIELDS,"^",15)>OREND)) Q
  1. . I $P(FIELDS,"^",9)["DISCONTINUED",(TYPE="OP"!(TYPE="NV")) D
  1. .. K ^TMP("ORXPS",$J) M ^TMP("ORXPS",$J)=^TMP("PS",$J)
  1. .. D OEL^PSOORRL(DFN,$P(FIELDS,"^")) ;This API uses same ^TMP("PS" global
  1. .. S ORIFN=+$P(^TMP("PS",$J,0),"^",11) I ORIFN S STOPDT=$P(^OR(100,ORIFN,0),"^",9)
  1. .. M ^TMP("PS",$J)=^TMP("ORXPS",$J) K ^TMP("ORXPS",$J)
  1. .. I TYPE="NV",'$L($P(FIELDS,"^",4)) S $P(FIELDS,"^",4)=STOPDT
  1. .. I TYPE="OP" S $P(FIELDS,"^",4)=STOPDT
  1. . I $O(^TMP("PS",$J,ITMP,"A",0))>0 S TYPE="IV"
  1. . I $O(^TMP("PS",$J,ITMP,"B",0))>0 S TYPE="IV"
  1. . I (TYPE="UD")!(TYPE="CP") D UDINST^ORWPS(.INSTRUCT,ITMP)
  1. . I TYPE="OP" D OPINST^ORWPS(.INSTRUCT,ITMP)
  1. . I TYPE="IV" D IVINST^ORWPS(.INSTRUCT,ITMP)
  1. . I TYPE="NV" D NVINST^ORWPS(.INSTRUCT,ITMP),NVREASON^ORWPS(.REASON,.NVSDT,ITMP)
  1. . I (TYPE="UD")!(TYPE="IV")!(TYPE="NV")!(TYPE="CP") D SETMULT^ORWPS(COMMENTS,ITMP,"SIO")
  1. . M COMMENTS=@COMMENTS
  1. . I $D(COMMENTS(1)) S COMMENTS(1)="\"_COMMENTS(1)
  1. . I '$L($P(FIELDS,U,15)) S:TYPE="NV" $P(FIELDS,U,15)=$P($G(NVSDT),".") ;Set Start Date for non-VA Med (from file 100, which currently doesn't get set)
  1. . I LOC S ^TMP("ORPS",$J,$$NXT)="~CP:"_LOCEX_U_FIELDS
  1. . E S ^TMP("ORPS",$J,$$NXT)="~"_TYPE_U_FIELDS
  1. . S J=0 F S J=$O(INSTRUCT(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)=INSTRUCT(J)
  1. . S J=0 F S J=$O(COMMENTS(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)="t"_COMMENTS(J)
  1. . S J=0 F S J=$O(REASON(J)) Q:'J S ^TMP("ORPS",$J,$$NXT)="t"_REASON(J)
  1. K ^TMP("PS",$J),^TMP("ORACT",$J)
  1. Q
  1. NXT() ; increment ILST
  1. S ILST=ILST+1
  1. Q ILST
  1. ;
  1. GETMED ;
  1. N J,ORIPS,ORIPSS,ORRXNO,ORSTAT,ORQTY,OREXP,ORISSUE,ORLAST,ORREF,ORPRVD,ORCOST,ORSIG,ORT,ORX0
  1. N ECD,GMR,GMW,IX,PSOBEGIN,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,X,NONVA,INST,OLDORI,RT,X,X2,X3,ORII,ORKK
  1. N AFND,ORORD,ILST
  1. S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
  1. ;Sorted by STATUS then by DRUG NAME
  1. K ^TMP("ORDATA",$J),^TMP("ORT",$J)
  1. I '$L($T(GCPR^OMGCOAS1)) D
  1. . K ^TMP("ORPS",$J)
  1. . D @GO
  1. S (OLDORI,ORIPS,ORT)=0
  1. F S ORIPS=$O(^TMP("ORPS",$J,ORIPS)) Q:(ORIPS'>0) S X=$G(^(ORIPS)) I X'="" D
  1. . I $E(X)="~" D Q
  1. .. S OLDORI=ORIPS,ORT=0,X3=$S($L($P(X,"^",10)):$P(X,"^",10),1:"ZUNKNOWN"),X2=$S($L($P(X,"^",3)):$P(X,"^",3),1:"ZUNKNOWN")
  1. .. S ^TMP("ORT",$J,X3,X2,ORIPS)=X
  1. . I $L(X2),$L(X3),$E(X)="\" S ORT=ORT+1,^TMP("ORT",$J,X3,X2,OLDORI,ORT)=$E(X,2,9999)
  1. S ORII=""
  1. F S ORII=$O(^TMP("ORT",$J,ORII)) Q:ORII="" S ORKK="" F S ORKK=$O(^TMP("ORT",$J,ORII,ORKK)) Q:ORKK="" D
  1. . S ORIPS=0 F S ORIPS=$O(^TMP("ORT",$J,ORII,ORKK,ORIPS)) Q:(ORIPS'>0) S ORX0=^(ORIPS),AFND=0 D
  1. .. I $E(ORX0)="~" D Q
  1. ... S ORPSPKG=$P($P(ORX0,U,2),";",2) ; mwa needed for FNDDRG^ORWDXC in ACHK
  1. ... S ORIPSS=$S($L($P(ORX0,U,10)):$E($P(ORX0,U,10),1,10),1:"UNK")_"_"_$S($L($P(ORX0,U,3)):$P(ORX0,U,3),1:"UNK")_"_"_ORIPS
  1. ... S ORORD=$P($P(ORX0,U,9),";") D ACHK Q:'AFND
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",1)="1^"_ORSITE ;Station ID
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",2)="2^"_$P(ORX0,U,3) ;Medication Name
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",3)="3^"_$P(ORX0,U,10) ;Status
  1. ... S X=$P($P(ORX0,"^",2),";",2),^TMP("ORDATA",$J,ORIPSS,"WP",4)="4^"_$S(X="I":"IN",X="C":"IN",1:"OUT") ;In/OutPatient
  1. ... S X=$P(ORX0,"^"),^TMP("ORDATA",$J,ORIPSS,"WP",5)="5^"_$S(X="~NV":"NonVAMed",1:"RX") ;Type: RX or NonVA Med
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",6)="6^"_$$DATE^ORDVU($P(ORX0,U,16)) ;Start Date
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",7)="7^"_$$DATE^ORDVU($P(ORX0,U,5)) ;Stop Date
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",8)="8^"_$$DATE^ORDVU($P(ORX0,U,11)) ;Last Fill Date
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",9)="9^"_$P(ORX0,U,18) ;Provider
  1. ... S ^TMP("ORDATA",$J,ORIPSS,"WP",12)="12^[+]" ;flag for detail
  1. ... S ORT=0 F S ORT=$O(^TMP("ORT",$J,ORII,ORKK,ORIPS,ORT)) Q:'ORT S X=^(ORT),^TMP("ORDATA",$J,ORIPSS,"WP",10,ORT)="10^"_X ;Instructions
  1. K ^TMP("ORPS",$J),^TMP("ORXPND",$J),^TMP("ORT",$J)
  1. S ROOT=$NA(^TMP("ORDATA",$J))
  1. Q
  1. ACHK ; Order check for drug allergies
  1. N ORIDA,ORORI,ORPXI,ILST,ORKDD,ORPSA,ORII,ORX
  1. Q:'$D(^OR(100,ORORD,.1))
  1. S ILST=1
  1. D FNDDRG^ORWDXC(.ORX,+ORORD,ORPSPKG)
  1. S ORII="" F S ORII=$O(ORX(ORII)) Q:'ORII D
  1. .N NPTR,LPTR,HL7,OI
  1. . S OI=$P(ORX(ORII),"|")
  1. . S HL7=$P(ORX(ORII),"|",3)
  1. . S NPTR=$P(HL7,U)
  1. . S LPTR=$P(HL7,U,4)
  1. . I '$L($G(LPTR)) D Q
  1. ..D OI2DD(.ORPSA,OI,ORPSPKG)
  1. ..S ORKDD="" F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
  1. ...S NPTR=$P(ORKDD,";",2)
  1. ...S LPTR=+ORKDD
  1. ...S AFND=$$ORCHK2^GMRAOR(DFN,"DR",$G(NPTR)_$S($G(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL")
  1. ...I AFND D ADETAIL
  1. .S AFND=$$ORCHK2^GMRAOR(DFN,"DR",$G(NPTR)_$S($G(NPTR)'[".":".",1:"")_"."_LPTR,"","ORALL") ; ICR 2378
  1. .I AFND D ADETAIL
  1. Q
  1. ADETAIL ;
  1. ; Set detail lines from ORALL array
  1. N ADA,ASDA,ASEVDA
  1. S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
  1. F ADA=1:1:ORALL I $D(ORALL(ADA,"MESSAGE")) D
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Causative agent: "_$P(ORALL(ADA,"MESSAGE",2),"^",2)
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Symptons: "_$P(ORALL(ADA,"MESSAGE",2),"^",1)
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Drug Class: "_$G(ORALL(ADA,"MESSAGE","OFFENDERS","CLS"))
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
  1. . S ASDA="" F S ASDA=$O(ORALL(ADA,"MESSAGE",1,ASDA)) Q:ASDA="" I $D(ORALL(ADA,"MESSAGE",1,ASDA)) D
  1. . . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Originator: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",1)
  1. . . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Originated: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",3)
  1. . . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^Observed/Historical: "_$P(ORALL(ADA,"MESSAGE",1,ASDA),"^",4)
  1. . . I $D(ORALL(ADA,"MESSAGE",1,ASDA,1)) S ASEVDA="" F S ASEVDA=$O(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA)) Q:ASEVDA="" I $D(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA)) D
  1. . . . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^ Obs Dates/Severity: "_$P(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",1)_" - "_$P(ORALL(ADA,"MESSAGE",1,ASDA,1,ASEVDA),"^",2)
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^-------------------------------------------------------"
  1. . S ^TMP("ORDATA",$J,ORIPSS,"WP",11,$$NXT)="11^"
  1. Q
  1. OI2DD(ORPSA,OROI,ORPSPKG) ;
  1. N PSOI
  1. Q:'$D(^ORD(101.43,OROI,0))
  1. S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
  1. Q:+$G(PSOI)<1
  1. D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
  1. Q