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