- ORKCHK5 ;SLC/CLA - SUPPORT ROUTINE FOR ACCEPT MODE ORDER CHECKS ;Aug 09, 2021@10:50:14
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190,280,357,345,269,382,539,562,405**;Dec 17, 1997;Build 211
- ;
- ; Reference to ORCHK2^GMRAOR is supported by ICR #2378
- ; Reference to DS^PSSDSAPI is supported by ICR #5425
- ; Reference to ORDERCHK^PXRMORCH is supported by ICR #5531
- ;
- Q
- EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE,OROIL,ORDODSG) ;perform order checking for orderable item acceptance
- ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED
- ; 1 FOR PERFORM DOSAGE CHECKS
- ; 0 FOR DO NOT PERFORM DOSAGE CHECKS
- Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
- ;
- N OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
- N OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
- ;
- S OI=$P(ORKA,"|"),ORKDG=$P(ORKA,"|",2),HL7=$P(ORKA,"|",3)
- S ODT=$P(ORKA,"|",4),ORNUM=$P(ORKA,"|",5),ORKPDATA=$P(ORKA,"|",6)
- S HL7NPTR=$P(HL7,U),HL7NTXT=$P(HL7,U,2),HL7NCOD=$P(HL7,U,3)
- S HL7LPTR=$P(HL7,U,4),HL7LTXT=$P(HL7,U,5),HL7LCOD=$P(HL7,U,6)
- I ORKDG="GMRC",'$L(ODT) S ODT=$$NOW^XLFDT ;def consult order d/t is now
- ;
- I $E(ORKDG,1,2)="PS" D PHARM
- I $E(ORKDG,1,2)'="PS",($E(ORKDG,1,2)'="LR"),($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D DUPOR
- I $E(ORKDG,1,2)="LR",($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D
- .D DUPLAB
- .D LABFREQ
- I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- D:ORKMODE'="ALLERGY" REMCHK(.ORKS,OI,ORKDFN) ;do reminder order checks
- Q
- ;
- PHARM ;process pharmacy order checks:
- N ORPSPKG,ORPSA,ORKDD
- N ORALLRN,ORALLRF,ORALLRD
- D PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
- ;
- D:+ORDODSG DSGCHK(.ORKS,ORKDFN,.OROIL,ORKA) ;do pharmacy dosage checks
- ;dispense drug selected:
- I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
- .D:ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) RXOCS
- .D:ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- ;
- ;dispense drug NOT selected, split OI into dispense drugs:
- I '$L($G(HL7LPTR)) D
- .S ORPSPKG=$E(ORKDG,3)
- .I ORPSPKG="H" S ORPSPKG="X" ;change to "X" if "H"erbal/non-VA med
- .I "IOX"[ORPSPKG D OI2DD(.ORPSA,OI,ORPSPKG)
- .S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
- ..S HL7LTXT=ORPSA(ORKDD)
- ..S HL7NPTR=$P(ORKDD,";",2)
- ..S HL7LPTR=+ORKDD
- ..S HL7LCOD="99PSD",HL7NCOD="99NDF"
- ..S $P(HL7,U)=HL7NPTR,$P(HL7,U,3)=HL7NCOD
- ..S $P(HL7,U,4)=HL7LPTR,$P(HL7,U,5)=HL7LTXT,$P(HL7,U,6)=HL7LCOD
- ..S $P(ORKA,"|",3)=HL7 ;set these for MLM OCX call
- ..D:ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) RXOCS
- ..D:ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- Q
- ;
- RXOCS ;drug-allergy interaction
- Q:ORALLRF="D"
- N DATA,J,DELIMIT,CRC16,FCOUNT,NUM
- Q:$$ORCHK2^GMRAOR(ORKDFN,"DR",$G(HL7NPTR)_$S($G(HL7NPTR)'[".":".",1:"")_"."_$G(HL7LPTR),,"DATA")<1
- F J=1:1:DATA D
- .N SIGN,GMRALLER,REACTANT,TEXT,ITM,ITEMS,NODE,COUNT,SEVERE,K,SITE,ORREMOTE,ORREMLST,MECH
- .S FCOUNT=2,GMRALLER=$P(DATA(J,"MESSAGE",2),U,3),REACTANT=$P(DATA(J,"MESSAGE",2),U,2),ORREMOTE=0,ORREMLST=""
- .;Previous [SEVERITY] adverse reaction
- .S K="" F S K=$O(DATA(J,K)) Q:K=""!(K'="MESSAGE")
- .I K'="" D
- ..S SITE=$P(DATA(J,K),U),SEVERE=$P(DATA(J,K),U,4),MECH=$P(DATA(J,K),U,11)
- ..I SEVERE'="" F ITM=1:1:$L(SEVERE,"~") I $P($P(SEVERE,"~",ITM),"|",2)>$G(SEVERE("MSG")) S SEVERE("MSG")=$P($P(SEVERE,"~",ITM),"|",2),SEVERE("MSG","NODE")=ITM
- .S ORKMSG="Previous "_$P(DATA(J,"MESSAGE",1,SITE),U,4)_" "_$S($G(SEVERE("MSG","NODE"))'="":$P(DATA(J,"MESSAGE",1,SITE,1,SEVERE("MSG","NODE")),U,2)_" ",1:"")_$S(MECH="A":"allergy ",MECH="P":"adverse reaction ",1:"unknown reaction ")
- .;to [GMR ALLERGY]
- .I GMRALLER="",(REACTANT'="") S GMRALLER=REACTANT
- .I GMRALLER'="" S ORKMSG=ORKMSG_"to "_GMRALLER_" "
- .;[[REACTANT]]
- .S ORKMSG=ORKMSG_$S(GMRALLER'=REACTANT:"["_REACTANT_"] ",1:"")
- .S ORKMSG=$P(ORKMSG,"[] ")
- .;(based on {INGREDIENT [DRUG_INGREDIENT]|DRUG CLASS [DRUG CLASS]|REACTANT [REACTANT]})
- .F NODE="ING","CLS","REC" I $D(DATA(J,"MESSAGE","OFFENDERS",NODE)) D
- ..S DELIMIT=", ",TEXT=""
- ..F ITM=1:1:$L(DATA(J,"MESSAGE","OFFENDERS",NODE),"~") D
- ...S:ITM=$L(DATA(J,"MESSAGE","OFFENDERS",NODE),"~") DELIMIT=" and "
- ...S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(DATA(J,"MESSAGE","OFFENDERS",NODE),"~",ITM)
- ..S TEXT(1)=$S(NODE="ING":"DRUG INGREDIENT",NODE="CLS":"DRUG CLASS",NODE="REC":"REACTANT",1:"")
- ..I TEXT[" and " S TEXT(1)=TEXT(1)_$S(NODE="CLS":"ES",1:"S")
- ..S TEXT("OUT")=$S($G(TEXT("OUT"))'="":TEXT("OUT")_"~",1:"")_TEXT(1)_" "_TEXT
- .S DELIMIT=", ",TEXT=""
- .F ITM=1:1:$L(TEXT("OUT"),"~") D
- ..S:ITM=$L(TEXT("OUT"),"~") DELIMIT=" and "
- ..S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(TEXT("OUT"),"~",ITM)
- .S:$G(TEXT)'="" ORKMSG=ORKMSG_"(based on "_TEXT_") "
- .;resulted in [SIGNS/SYMPTOMS]
- .I $P(DATA(J,"MESSAGE",2),U)'="" S ORKMSG=ORKMSG_"resulted in "_$P(DATA(J,"MESSAGE",2),U)_" "
- .;([STATION NAME] entered on [DOCUMENTATION DATE/TIME]).
- .K TEXT
- .S DELIMIT=", ",COUNT=1,COUNT("TOTAL")=DATA(J,"MESSAGE",1)
- .S ITM=0 F S ITM=$O(DATA(J,"MESSAGE",1,ITM)) Q:ITM="" D
- ..S:COUNT=COUNT("TOTAL") DELIMIT=" and "
- ..S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(DATA(J,"MESSAGE",1,ITM),U)_" entered on "_$P(DATA(J,"MESSAGE",1,ITM),U,3)
- ..;check for remote allergies and related comments
- ..I $P(DATA(J,"MESSAGE",1,ITM),U,2)["REMOTE" D
- ... S ORREMOTE=1
- ..S COUNT=1+COUNT
- .S ORKMSG=ORKMSG_"("_TEXT_")."
- .S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
- .;SAVE DATA FOR ORDER CHECK INSTANCES FILE ENTRY
- .S CRC16=$$CRC16^XLFCRC(ORKMSG),NUM=0
- .S ITM="" F S ITM=$O(DATA(J,ITM)) Q:ITM="" D
- ..Q:ITM="MESSAGE"
- ..S NUM=1+$G(NUM)
- ..K:NUM=1 ^TMP("OROCIDATA",$J,CRC16)
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,.01)=$P(DATA(J,ITM),U,6)
- ..S:$P(DATA(J,ITM),U,7)'="" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,2)=$P(DATA(J,ITM),U,7)
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,6)=$P(DATA(J,ITM),U,2)
- ..S:$P(DATA(J,ITM),U,2)="R" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,7)=$P(DATA(J,ITM),U)
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,8)=$P(DATA(J,ITM),U,3)
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,9)=$$UP^XLFSTR($P(DATA(J,ITM),U,8))
- ..S:$G(SEVERE("MSG"))'="" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,10)=SEVERE("MSG")
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,11)=$P(DATA(J,ITM),U,10)
- ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,9)=$$UP^XLFSTR($P(DATA(J,ITM),U,8))
- ..F ITM(1)=1:1:$L($P(DATA(J,ITM),U,5),"~") S ^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,"+"_ITM(1)_",")=$P($P(DATA(J,ITM),U,5),"~",ITM(1))
- ..S FCOUNT=ITM(1)+1
- ..S ^TMP("OROCIDATA",$J,CRC16,100.05,84)=$P(DATA(J,ITM),U,9)
- ..F NODE="ING","CLS" I $D(DATA(J,ITM,NODE)) F ITM(1)=1:1:$L(DATA(J,ITM,NODE),"~") D
- ...S ^TMP("OROCIDATA",$J,CRC16,$S(NODE="ING":"INGREDIENT",NODE="CLS":"CLASS",1:""),NUM,"+"_FCOUNT_",")=$P(DATA(J,ITM,NODE),"~",ITM(1)),FCOUNT=FCOUNT+1
- ..S ORREMLST=$P(DATA(J,ITM),U)_";"_$P(DATA(J,ITM),U,6)_"^"_$P(DATA(J,ITM),U,10)
- .;Now save the message to the ORKS array (moved here to allow for remote allergy comment changes)
- .S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG_U_ORREMOTE_U_ORREMLST
- Q
- ;
- OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
- 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
- ;
- DUPOR ;duplicate orders for non-pharmacy and non-lab:
- S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
- Q:+$G(OCN)<1
- Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- N ORKOR S ORKOR=0
- D DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG) I (ORKOR>0) D
- .S ORKOCNUM=+$P(ORKOR,U)
- .S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- .S ORKMSG="Duplicate order: "_$P(ORKOR,U,2)
- .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
- Q
- ;
- DUPLAB ;duplicate laboratory orders:
- N ORKLR,OCI
- S ORKLR=0,OCI=""
- S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
- Q:+$G(OCN)<1
- Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- D DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
- F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
- .S ORKOCNUM=+$P(ORKLR(OCI),U)
- .S ORKMSG="Duplicate order: "_$P(ORKLR(OCI),U,2)
- .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
- Q
- ;
- LABFREQ ;lab order frequency restrictions:
- N ORKLR,OCI
- S ORKLR=0,OCI=""
- S OCN=0,OCN=$O(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
- Q:+$G(OCN)<1
- Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- D ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
- S OCI="" F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
- .S ORKMSG=$P(ORKLR(OCI),U,2)
- .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
- Q
- ;
- PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
- S ORKNUM=0,ORKNUM=$O(^ORD(100.8,"B",ORKNAME,ORKNUM))
- S ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
- S ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
- Q
- REMCHK(ORRET,OROI,ORDFN) ; DO REMINDER ORDER CHECKS
- ;
- N ORKGLOB S ORKGLOB=$H
- ;order check for TEST OC for this OI
- N ORKNUM,ORKFLAG,ORKDNGR
- D PARAMS("CLINICAL REMINDER TEST",.ORKNUM,.ORKFLAG,.ORKDNGR)
- I ORKFLAG'="D" D
- .D ORDERCHK^PXRMORCH(ORDFN,OROI,1,0,0)
- .Q:'$D(^TMP($J,OROI))
- .N ORCDL S ORCDL="" F S ORCDL=$O(^TMP($J,OROI,ORCDL)) Q:'$L(ORCDL) S ORKDNGR=$S(ORCDL="H":1,ORCDL="M":2,1:3) D
- ..N ORRULE S ORRULE="" F S ORRULE=$O(^TMP($J,OROI,ORCDL,ORRULE)) Q:'$L(ORRULE) D
- ...S ORRET("ORK",ORCDL_","_$G(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
- ...M ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($J,OROI,ORCDL,ORRULE)
- .K ^TMP($J,OROI)
- ;order checks for LIVE OC for this OI
- K ORKNUM,ORKFLAG,ORKDNGR
- D PARAMS("CLINICAL REMINDER LIVE",.ORKNUM,.ORKFLAG,.ORKDNGR)
- Q:ORKFLAG="D"
- D ORDERCHK^PXRMORCH(ORDFN,OROI,0,0,0)
- Q:'$D(^TMP($J,OROI))
- N ORCDL S ORCDL="" F S ORCDL=$O(^TMP($J,OROI,ORCDL)) Q:'$L(ORCDL) S ORKDNGR=$S(ORCDL="H":1,ORCDL="M":2,1:3) D
- .N ORRULE S ORRULE="" F S ORRULE=$O(^TMP($J,OROI,ORCDL,ORRULE)) Q:'$L(ORRULE) D
- ..S ORRET("ORK",ORCDL_","_$G(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
- ..M ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($J,OROI,ORCDL,ORRULE)
- K ^TMP($J,OROI)
- Q
- ;
- DSGCHK(ORRET,ORDFN,OROIL,ORKA) ;DO DOSAGE ORDER CHECKS
- Q:'$$PATCH^XPDUTL("PSS*1.0*117")
- Q:$G(XQY0)="OR BCMA ORDER COM"
- N ORTYPE,ORY,ORI,ORKNUM,ORKFLAG,ORKDNGR
- D PARAMS("DRUG DOSAGE",.ORKNUM,.ORKFLAG,.ORKDNGR)
- Q:ORKFLAG="D" ;this checks if the order check is turned on or not
- I '$$DS^PSSDSAPI D Q
- .N ORDWNMSG S ORDWNMSG=$$DSDWNMSG^ORDSGCHK
- .S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORDWNMSG)=ORNUM_U_25_U_2_ORDWNMSG
- S ORTYPE=$P(ORKA,"|",2)
- D EN^ORDSGCHK(.ORY,ORDFN,ORTYPE,.OROIL)
- N ORI S ORI=0 F S ORI=$O(ORY(ORI)) Q:'ORI D
- .I $P(ORY(ORI),U)="ERR" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_2_U_$P(ORY(ORI),U,2)
- .I $P(ORY(ORI),U)="DS" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$P(ORY(ORI),U,2)
- .N ORIPAD S ORIPAD=$$PAD^ORUTL(ORI,3)_ORI
- .I $P(ORY(ORI),U)="ERR" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_3_U_$P(ORY(ORI),U,2)
- .I $P(ORY(ORI),U)="DS" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$P(ORY(ORI),U,2)
- .I $P(ORY(ORI),U)="INFO" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_3_U_$P(ORY(ORI),U,2)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKCHK5 12024 printed Feb 18, 2025@23:57:37 Page 2
- ORKCHK5 ;SLC/CLA - SUPPORT ROUTINE FOR ACCEPT MODE ORDER CHECKS ;Aug 09, 2021@10:50:14
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190,280,357,345,269,382,539,562,405**;Dec 17, 1997;Build 211
- +2 ;
- +3 ; Reference to ORCHK2^GMRAOR is supported by ICR #2378
- +4 ; Reference to DS^PSSDSAPI is supported by ICR #5425
- +5 ; Reference to ORDERCHK^PXRMORCH is supported by ICR #5531
- +6 ;
- +7 QUIT
- EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE,OROIL,ORDODSG) ;perform order checking for orderable item acceptance
- +1 ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED
- +2 ; 1 FOR PERFORM DOSAGE CHECKS
- +3 ; 0 FOR DO NOT PERFORM DOSAGE CHECKS
- +4 if $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
- QUIT
- +5 ;
- +6 NEW OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
- +7 NEW OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
- +8 ;
- +9 SET OI=$PIECE(ORKA,"|")
- SET ORKDG=$PIECE(ORKA,"|",2)
- SET HL7=$PIECE(ORKA,"|",3)
- +10 SET ODT=$PIECE(ORKA,"|",4)
- SET ORNUM=$PIECE(ORKA,"|",5)
- SET ORKPDATA=$PIECE(ORKA,"|",6)
- +11 SET HL7NPTR=$PIECE(HL7,U)
- SET HL7NTXT=$PIECE(HL7,U,2)
- SET HL7NCOD=$PIECE(HL7,U,3)
- +12 SET HL7LPTR=$PIECE(HL7,U,4)
- SET HL7LTXT=$PIECE(HL7,U,5)
- SET HL7LCOD=$PIECE(HL7,U,6)
- +13 ;def consult order d/t is now
- IF ORKDG="GMRC"
- IF '$LENGTH(ODT)
- SET ODT=$$NOW^XLFDT
- +14 ;
- +15 IF $EXTRACT(ORKDG,1,2)="PS"
- DO PHARM
- +16 IF $EXTRACT(ORKDG,1,2)'="PS"
- IF ($EXTRACT(ORKDG,1,2)'="LR")
- IF ($LENGTH($GET(OI)))
- IF ($LENGTH($GET(ODT)))
- IF (ORKTMODE'="ALL")
- DO DUPOR
- +17 IF $EXTRACT(ORKDG,1,2)="LR"
- IF ($LENGTH($GET(OI)))
- IF ($LENGTH($GET(ODT)))
- IF (ORKTMODE'="ALL")
- Begin DoDot:1
- +18 DO DUPLAB
- +19 DO LABFREQ
- End DoDot:1
- +20 IF $EXTRACT(ORKDG,1,2)'="PS"
- DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- +21 ;do reminder order checks
- if ORKMODE'="ALLERGY"
- DO REMCHK(.ORKS,OI,ORKDFN)
- +22 QUIT
- +23 ;
- PHARM ;process pharmacy order checks:
- +1 NEW ORPSPKG,ORPSA,ORKDD
- +2 NEW ORALLRN,ORALLRF,ORALLRD
- +3 DO PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
- +4 ;
- +5 ;do pharmacy dosage checks
- if +ORDODSG
- DO DSGCHK(.ORKS,ORKDFN,.OROIL,ORKA)
- +6 ;dispense drug selected:
- +7 IF $LENGTH($GET(HL7LPTR))
- IF ($GET(HL7LCOD)="99PSD")
- Begin DoDot:1
- +8 if ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV"))
- DO RXOCS
- +9 if ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV"))
- DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- End DoDot:1
- +10 ;
- +11 ;dispense drug NOT selected, split OI into dispense drugs:
- +12 IF '$LENGTH($GET(HL7LPTR))
- Begin DoDot:1
- +13 SET ORPSPKG=$EXTRACT(ORKDG,3)
- +14 ;change to "X" if "H"erbal/non-VA med
- IF ORPSPKG="H"
- SET ORPSPKG="X"
- +15 IF "IOX"[ORPSPKG
- DO OI2DD(.ORPSA,OI,ORPSPKG)
- +16 SET ORKDD=0
- FOR
- SET ORKDD=$ORDER(ORPSA(ORKDD))
- if 'ORKDD
- QUIT
- Begin DoDot:2
- +17 SET HL7LTXT=ORPSA(ORKDD)
- +18 SET HL7NPTR=$PIECE(ORKDD,";",2)
- +19 SET HL7LPTR=+ORKDD
- +20 SET HL7LCOD="99PSD"
- SET HL7NCOD="99NDF"
- +21 SET $PIECE(HL7,U)=HL7NPTR
- SET $PIECE(HL7,U,3)=HL7NCOD
- +22 SET $PIECE(HL7,U,4)=HL7LPTR
- SET $PIECE(HL7,U,5)=HL7LTXT
- SET $PIECE(HL7,U,6)=HL7LCOD
- +23 ;set these for MLM OCX call
- SET $PIECE(ORKA,"|",3)=HL7
- +24 if ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV"))
- DO RXOCS
- +25 if ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV"))
- DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- RXOCS ;drug-allergy interaction
- +1 if ORALLRF="D"
- QUIT
- +2 NEW DATA,J,DELIMIT,CRC16,FCOUNT,NUM
- +3 if $$ORCHK2^GMRAOR(ORKDFN,"DR",$GET(HL7NPTR)_$SELECT($GET(HL7NPTR)'["."
- QUIT
- +4 FOR J=1:1:DATA
- Begin DoDot:1
- +5 NEW SIGN,GMRALLER,REACTANT,TEXT,ITM,ITEMS,NODE,COUNT,SEVERE,K,SITE,ORREMOTE,ORREMLST,MECH
- +6 SET FCOUNT=2
- SET GMRALLER=$PIECE(DATA(J,"MESSAGE",2),U,3)
- SET REACTANT=$PIECE(DATA(J,"MESSAGE",2),U,2)
- SET ORREMOTE=0
- SET ORREMLST=""
- +7 ;Previous [SEVERITY] adverse reaction
- +8 SET K=""
- FOR
- SET K=$ORDER(DATA(J,K))
- if K=""!(K'="MESSAGE")
- QUIT
- +9 IF K'=""
- Begin DoDot:2
- +10 SET SITE=$PIECE(DATA(J,K),U)
- SET SEVERE=$PIECE(DATA(J,K),U,4)
- SET MECH=$PIECE(DATA(J,K),U,11)
- +11 IF SEVERE'=""
- FOR ITM=1:1:$LENGTH(SEVERE,"~")
- IF $PIECE($PIECE(SEVERE,"~",ITM),"|",2)>$GET(SEVERE("MSG"))
- SET SEVERE("MSG")=$PIECE($PIECE(SEVERE,"~",ITM),"|",2)
- SET SEVERE("MSG","NODE")=ITM
- End DoDot:2
- +12 SET ORKMSG="Previous "_$PIECE(DATA(J,"MESSAGE",1,SITE),U,4)_" "_$SELECT($GET(SEVERE("MSG","NODE"))'="":$PIECE(DATA(J,"MESSAGE",1,SITE,1,SEVERE("MSG","NODE")),U,2)_" ",1:"")_$SELECT(MECH="A":"allergy ",MECH="P":"adverse reaction ",1:"unk
- nown reaction ")
- +13 ;to [GMR ALLERGY]
- +14 IF GMRALLER=""
- IF (REACTANT'="")
- SET GMRALLER=REACTANT
- +15 IF GMRALLER'=""
- SET ORKMSG=ORKMSG_"to "_GMRALLER_" "
- +16 ;[[REACTANT]]
- +17 SET ORKMSG=ORKMSG_$SELECT(GMRALLER'=REACTANT:"["_REACTANT_"] ",1:"")
- +18 SET ORKMSG=$PIECE(ORKMSG,"[] ")
- +19 ;(based on {INGREDIENT [DRUG_INGREDIENT]|DRUG CLASS [DRUG CLASS]|REACTANT [REACTANT]})
- +20 FOR NODE="ING","CLS","REC"
- IF $DATA(DATA(J,"MESSAGE","OFFENDERS",NODE))
- Begin DoDot:2
- +21 SET DELIMIT=", "
- SET TEXT=""
- +22 FOR ITM=1:1:$LENGTH(DATA(J,"MESSAGE","OFFENDERS",NODE),"~")
- Begin DoDot:3
- +23 if ITM=$LENGTH(DATA(J,"MESSAGE","OFFENDERS",NODE),"~")
- SET DELIMIT=" and "
- +24 SET TEXT=$SELECT($GET(TEXT)'="":TEXT_DELIMIT,1:"")_$PIECE(DATA(J,"MESSAGE","OFFENDERS",NODE),"~",ITM)
- End DoDot:3
- +25 SET TEXT(1)=$SELECT(NODE="ING":"DRUG INGREDIENT",NODE="CLS":"DRUG CLASS",NODE="REC":"REACTANT",1:"")
- +26 IF TEXT[" and "
- SET TEXT(1)=TEXT(1)_$SELECT(NODE="CLS":"ES",1:"S")
- +27 SET TEXT("OUT")=$SELECT($GET(TEXT("OUT"))'="":TEXT("OUT")_"~",1:"")_TEXT(1)_" "_TEXT
- End DoDot:2
- +28 SET DELIMIT=", "
- SET TEXT=""
- +29 FOR ITM=1:1:$LENGTH(TEXT("OUT"),"~")
- Begin DoDot:2
- +30 if ITM=$LENGTH(TEXT("OUT"),"~")
- SET DELIMIT=" and "
- +31 SET TEXT=$SELECT($GET(TEXT)'="":TEXT_DELIMIT,1:"")_$PIECE(TEXT("OUT"),"~",ITM)
- End DoDot:2
- +32 if $GET(TEXT)'=""
- SET ORKMSG=ORKMSG_"(based on "_TEXT_") "
- +33 ;resulted in [SIGNS/SYMPTOMS]
- +34 IF $PIECE(DATA(J,"MESSAGE",2),U)'=""
- SET ORKMSG=ORKMSG_"resulted in "_$PIECE(DATA(J,"MESSAGE",2),U)_" "
- +35 ;([STATION NAME] entered on [DOCUMENTATION DATE/TIME]).
- +36 KILL TEXT
- +37 SET DELIMIT=", "
- SET COUNT=1
- SET COUNT("TOTAL")=DATA(J,"MESSAGE",1)
- +38 SET ITM=0
- FOR
- SET ITM=$ORDER(DATA(J,"MESSAGE",1,ITM))
- if ITM=""
- QUIT
- Begin DoDot:2
- +39 if COUNT=COUNT("TOTAL")
- SET DELIMIT=" and "
- +40 SET TEXT=$SELECT($GET(TEXT)'="":TEXT_DELIMIT,1:"")_$PIECE(DATA(J,"MESSAGE",1,ITM),U)_" entered on "_$PIECE(DATA(J,"MESSAGE",1,ITM),U,3)
- +41 ;check for remote allergies and related comments
- +42 IF $PIECE(DATA(J,"MESSAGE",1,ITM),U,2)["REMOTE"
- Begin DoDot:3
- +43 SET ORREMOTE=1
- End DoDot:3
- +44 SET COUNT=1+COUNT
- End DoDot:2
- +45 SET ORKMSG=ORKMSG_"("_TEXT_")."
- +46 SET ORKS("ORK",ORALLRD_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
- +47 ;SAVE DATA FOR ORDER CHECK INSTANCES FILE ENTRY
- +48 SET CRC16=$$CRC16^XLFCRC(ORKMSG)
- SET NUM=0
- +49 SET ITM=""
- FOR
- SET ITM=$ORDER(DATA(J,ITM))
- if ITM=""
- QUIT
- Begin DoDot:2
- +50 if ITM="MESSAGE"
- QUIT
- +51 SET NUM=1+$GET(NUM)
- +52 if NUM=1
- KILL ^TMP("OROCIDATA",$JOB,CRC16)
- +53 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,.01)=$PIECE(DATA(J,ITM),U,6)
- +54 if $PIECE(DATA(J,ITM),U,7)'=""
- SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,2)=$PIECE(DATA(J,ITM),U,7)
- +55 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,6)=$PIECE(DATA(J,ITM),U,2)
- +56 if $PIECE(DATA(J,ITM),U,2)="R"
- SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,7)=$PIECE(DATA(J,ITM),U)
- +57 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,8)=$PIECE(DATA(J,ITM),U,3)
- +58 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,9)=$$UP^XLFSTR($PIECE(DATA(J,ITM),U,8))
- +59 if $GET(SEVERE("MSG"))'=""
- SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,10)=SEVERE("MSG")
- +60 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,11)=$PIECE(DATA(J,ITM),U,10)
- +61 SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,9)=$$UP^XLFSTR($PIECE(DATA(J,ITM),U,8))
- +62 FOR ITM(1)=1:1:$LENGTH($PIECE(DATA(J,ITM),U,5),"~")
- SET ^TMP("OROCIDATA",$JOB,CRC16,"SIGN",NUM,"+"_ITM(1)_",")=$PIECE($PIECE(DATA(J,ITM),U,5),"~",ITM(1))
- +63 SET FCOUNT=ITM(1)+1
- +64 SET ^TMP("OROCIDATA",$JOB,CRC16,100.05,84)=$PIECE(DATA(J,ITM),U,9)
- +65 FOR NODE="ING","CLS"
- IF $DATA(DATA(J,ITM,NODE))
- FOR ITM(1)=1:1:$LENGTH(DATA(J,ITM,NODE),"~")
- Begin DoDot:3
- +66 SET ^TMP("OROCIDATA",$JOB,CRC16,$SELECT(NODE="ING":"INGREDIENT",NODE="CLS":"CLASS",1:""),NUM,"+"_FCOUNT_",")=$PIECE(DATA(J,ITM,NODE),"~",ITM(1))
- SET FCOUNT=FCOUNT+1
- End DoDot:3
- +67 SET ORREMLST=$PIECE(DATA(J,ITM),U)_";"_$PIECE(DATA(J,ITM),U,6)_"^"_$PIECE(DATA(J,ITM),U,10)
- End DoDot:2
- +68 ;Now save the message to the ORKS array (moved here to allow for remote allergy comment changes)
- +69 SET ORKS("ORK",ORALLRD_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG_U_ORREMOTE_U_ORREMLST
- End DoDot:1
- +70 QUIT
- +71 ;
- OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
- +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
- +7 ;
- DUPOR ;duplicate orders for non-pharmacy and non-lab:
- +1 SET OCN=0
- SET OCN=$ORDER(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
- +2 if +$GET(OCN)<1
- QUIT
- +3 if $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- QUIT
- +4 NEW ORKOR
- SET ORKOR=0
- +5 DO DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG)
- IF (ORKOR>0)
- Begin DoDot:1
- +6 SET ORKOCNUM=+$PIECE(ORKOR,U)
- +7 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- +8 SET ORKMSG="Duplicate order: "_$PIECE(ORKOR,U,2)
- +9 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_ORKOCNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
- End DoDot:1
- +10 QUIT
- +11 ;
- DUPLAB ;duplicate laboratory orders:
- +1 NEW ORKLR,OCI
- +2 SET ORKLR=0
- SET OCI=""
- +3 SET OCN=0
- SET OCN=$ORDER(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
- +4 if +$GET(OCN)<1
- QUIT
- +5 if $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- QUIT
- +6 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- +7 DO DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
- +8 FOR
- SET OCI=$ORDER(ORKLR(OCI))
- if OCI=""
- QUIT
- Begin DoDot:1
- +9 SET ORKOCNUM=+$PIECE(ORKLR(OCI),U)
- +10 SET ORKMSG="Duplicate order: "_$PIECE(ORKLR(OCI),U,2)
- +11 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_ORKOCNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
- End DoDot:1
- +12 QUIT
- +13 ;
- LABFREQ ;lab order frequency restrictions:
- +1 NEW ORKLR,OCI
- +2 SET ORKLR=0
- SET OCI=""
- +3 SET OCN=0
- SET OCN=$ORDER(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
- +4 if +$GET(OCN)<1
- QUIT
- +5 if $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
- QUIT
- +6 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
- +7 DO ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
- +8 SET OCI=""
- FOR
- SET OCI=$ORDER(ORKLR(OCI))
- if OCI=""
- QUIT
- Begin DoDot:1
- +9 SET ORKMSG=$PIECE(ORKLR(OCI),U,2)
- +10 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
- End DoDot:1
- +11 QUIT
- +12 ;
- PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
- +1 SET ORKNUM=0
- SET ORKNUM=$ORDER(^ORD(100.8,"B",ORKNAME,ORKNUM))
- +2 SET ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
- +3 SET ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
- +4 QUIT
- REMCHK(ORRET,OROI,ORDFN) ; DO REMINDER ORDER CHECKS
- +1 ;
- +2 NEW ORKGLOB
- SET ORKGLOB=$HOROLOG
- +3 ;order check for TEST OC for this OI
- +4 NEW ORKNUM,ORKFLAG,ORKDNGR
- +5 DO PARAMS("CLINICAL REMINDER TEST",.ORKNUM,.ORKFLAG,.ORKDNGR)
- +6 IF ORKFLAG'="D"
- Begin DoDot:1
- +7 DO ORDERCHK^PXRMORCH(ORDFN,OROI,1,0,0)
- +8 if '$DATA(^TMP($JOB,OROI))
- QUIT
- +9 NEW ORCDL
- SET ORCDL=""
- FOR
- SET ORCDL=$ORDER(^TMP($JOB,OROI,ORCDL))
- if '$LENGTH(ORCDL)
- QUIT
- SET ORKDNGR=$SELECT(ORCDL="H":1,ORCDL="M":2,1:3)
- Begin DoDot:2
- +10 NEW ORRULE
- SET ORRULE=""
- FOR
- SET ORRULE=$ORDER(^TMP($JOB,OROI,ORCDL,ORRULE))
- if '$LENGTH(ORRULE)
- QUIT
- Begin DoDot:3
- +11 SET ORRET("ORK",ORCDL_","_$GET(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
- +12 MERGE ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($JOB,OROI,ORCDL,ORRULE)
- End DoDot:3
- End DoDot:2
- +13 KILL ^TMP($JOB,OROI)
- End DoDot:1
- +14 ;order checks for LIVE OC for this OI
- +15 KILL ORKNUM,ORKFLAG,ORKDNGR
- +16 DO PARAMS("CLINICAL REMINDER LIVE",.ORKNUM,.ORKFLAG,.ORKDNGR)
- +17 if ORKFLAG="D"
- QUIT
- +18 DO ORDERCHK^PXRMORCH(ORDFN,OROI,0,0,0)
- +19 if '$DATA(^TMP($JOB,OROI))
- QUIT
- +20 NEW ORCDL
- SET ORCDL=""
- FOR
- SET ORCDL=$ORDER(^TMP($JOB,OROI,ORCDL))
- if '$LENGTH(ORCDL)
- QUIT
- SET ORKDNGR=$SELECT(ORCDL="H":1,ORCDL="M":2,1:3)
- Begin DoDot:1
- +21 NEW ORRULE
- SET ORRULE=""
- FOR
- SET ORRULE=$ORDER(^TMP($JOB,OROI,ORCDL,ORRULE))
- if '$LENGTH(ORRULE)
- QUIT
- Begin DoDot:2
- +22 SET ORRET("ORK",ORCDL_","_$GET(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
- +23 MERGE ^TMP($JOB,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($JOB,OROI,ORCDL,ORRULE)
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP($JOB,OROI)
- +25 QUIT
- +26 ;
- DSGCHK(ORRET,ORDFN,OROIL,ORKA) ;DO DOSAGE ORDER CHECKS
- +1 if '$$PATCH^XPDUTL("PSS*1.0*117")
- QUIT
- +2 if $GET(XQY0)="OR BCMA ORDER COM"
- QUIT
- +3 NEW ORTYPE,ORY,ORI,ORKNUM,ORKFLAG,ORKDNGR
- +4 DO PARAMS("DRUG DOSAGE",.ORKNUM,.ORKFLAG,.ORKDNGR)
- +5 ;this checks if the order check is turned on or not
- if ORKFLAG="D"
- QUIT
- +6 IF '$$DS^PSSDSAPI
- Begin DoDot:1
- +7 NEW ORDWNMSG
- SET ORDWNMSG=$$DSDWNMSG^ORDSGCHK
- +8 SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_ORDWNMSG)=ORNUM_U_25_U_2_ORDWNMSG
- End DoDot:1
- QUIT
- +9 SET ORTYPE=$PIECE(ORKA,"|",2)
- +10 DO EN^ORDSGCHK(.ORY,ORDFN,ORTYPE,.OROIL)
- +11 NEW ORI
- SET ORI=0
- FOR
- SET ORI=$ORDER(ORY(ORI))
- if 'ORI
- QUIT
- Begin DoDot:1
- +12 IF $PIECE(ORY(ORI),U)="ERR"
- SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_$EXTRACT($PIECE(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_2_U_$PIECE(ORY(ORI),U,2)
- +13 IF $PIECE(ORY(ORI),U)="DS"
- SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_$EXTRACT($PIECE(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$PIECE(ORY(ORI),U,2)
- +14 NEW ORIPAD
- SET ORIPAD=$$PAD^ORUTL(ORI,3)_ORI
- +15 IF $PIECE(ORY(ORI),U)="ERR"
- SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_ORIPAD_","_$EXTRACT($PIECE(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_3_U_$PIECE(ORY(ORI),U,2)
- +16 IF $PIECE(ORY(ORI),U)="DS"
- SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_ORIPAD_","_$EXTRACT($PIECE(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$PIECE(ORY(ORI),U,2)
- +17 IF $PIECE(ORY(ORI),U)="INFO"
- SET ORRET("ORK",ORKDNGR_","_$GET(ORNUM)_","_ORIPAD_","_$EXTRACT($PIECE(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_3_U_$PIECE(ORY(ORI),U,2)
- End DoDot:1
- +18 QUIT