- ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;Jun 18, 2021@08:44:23
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**213,243,413,547,405**;Dec 17, 1997;Build 211
- ;
- PTR(X) ; -- Return ptr to prompt OR GTX X
- Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
- ;
- PARENT ; -- create parent order for backdoor complex renewals
- ; Expects ORIFN, ORIG, ORDIALOG()
- ;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
- N ORIGDAD,ORIFNDAD,HDR S ORIGDAD=$P($G(^OR(100,ORIG,3)),U,9)
- Q:ORIGDAD<1 Q:$$DOSES^ORCACT4(ORIGDAD)'>1 ;cont if complex
- S ORIFNDAD=$P($G(^OR(100,ORIGDAD,3)),U,6) I ORIFNDAD<1 D G P1
- . N ORIFN D EN^ORCSAVE Q:ORIFN<1
- . S $P(^OR(100,ORIFN,3),U,5)=ORIGDAD,$P(^(3),U,8)=1,$P(^(3),U,11)=2
- . S $P(^OR(100,ORIGDAD,3),U,6)=ORIFN,ORIFNDAD=ORIFN
- . D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
- . D SIGSTS^ORCSAVE2(ORIFN,1),DATES^ORCSAVE2(ORIFN,ORSTRT)
- . I $P(^OR(100,ORIFN,8,1,0),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;sign children instead
- . ;STATUS updated in SN2^ORMPS from child orders
- P0 ; -- just add conjunction, new dose if DAD already exists
- N INST,DA,PTR,ID,P,I,J,X
- S INST=$$DOSES^ORCACT4(ORIFNDAD),DA=$O(^OR(100,ORIFNDAD,4.5,"A"),-1)
- S PTR=$$PTR("AND/THEN"),ID="CONJ",DA=DA+1
- S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)="A"
- S ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)="",INST=INST+1
- F P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG" D
- . S PTR=$$PTR(P) Q:'$L($G(ORDIALOG(PTR,1)))
- . S DA=DA+1,ID=$P($G(^ORD(101.41,PTR,1)),U,3)
- . S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)=ORDIALOG(PTR,1)
- . S ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
- S $P(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
- S P=$$PTR("SIG"),DA=+$O(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
- S I=+$O(^OR(100,ORIFNDAD,4.5,DA,2,""),-1),X=$G(^(I,0)) S:$L(X) X=X_" AND",^(0)=X
- S J=0 F S J=$O(^TMP("ORWORD",$J,PTR,1,J)) Q:J<1 S I=I+1,^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$J,PTR,1,J,0)
- S $P(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
- ; -- rebuild order text w/new SIG
- K ^TMP("ORWORD",$J,PTR) M ^TMP("ORWORD",$J,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
- K ^OR(100,ORIFNDAD,8,1,.1) D ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
- P1 ; -- set up links
- S $P(^OR(100,ORIFN,3),U,9)=ORIFNDAD
- S HDR=$G(^OR(100,ORIFNDAD,2,0)),^(0)="^100.002PA^"_ORIFN_U_($P(HDR,U,4)+1),^(ORIFN,0)=ORIFN
- Q
- ;
- NTE(ID) ; -- Return subscript of NTE|ID segment
- N I,SEG,Y S Y="",I=+RXE S:'$G(ID) ID=21
- F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=@ORMSG@(I) Q:$E(SEG,1,3)="ORC" I $P(SEG,"|",1,2)=("NTE|"_ID) S Y=I Q
- Q Y
- ;
- NTXT(NTE) ; -- Return string of text in ORMSG(NTE)
- N Y,I S NTE=+$G(NTE)
- S Y=$P($G(@ORMSG@(NTE)),"|",4),Y=$$UNESC^ORHLESC(Y)
- S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I<1 S Y=Y_" "_$$UNESC^ORHLESC(@ORMSG@(NTE,I))
- Q Y
- ;
- ZSC() ; -- Return subscript of ZSC segment
- N I,SEG,Y S Y="",I=+RXE
- F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="ZSC" S Y=I_U_@ORMSG@(I) Q
- Q Y
- ;
- NUMADDS() ; -- count number of additives to determine type
- N CNT,I,X S CNT=0,I=+RXE
- F S I=$O(@ORMSG@(I)) Q:I'>0 S X=@ORMSG@(I) Q:$P(X,"|")="ORC" I $E(X,1,6)="RXC|A|" S CNT=CNT+1
- Q CNT
- ;
- DURATION(X) ; -- Returns "# units" from U# format
- N Y,Y1,Y2 I X'?.1U1.N Q ""
- S Y1=$E(X),Y2=+$E(X,2,$L(X)) I X=+X S Y1="D",Y2=+X
- S Y=Y2_" "_$S(Y1="L":"MONTH",Y1="W":"WEEK",Y1="H":"HOUR",Y1="M":"MINUTE",Y1="S":"SECOND",1:"DAY")_$S(Y2>1:"S",1:"")
- Q Y
- ;
- UPD ; -- Compare ORMSG to order, update responses [from SC^ORMPS]
- ; Also expects ORIFN,ORNP,ORCAT,OR3,RXE,ZRX,PKGIFN
- N X,I,ORDER,ZSC,NTE,PI,RXO
- S ORDER=+$G(ORIFN),I=+$P(ORIFN,";",2) I I<1 D
- . S I=+$P(OR3,U,7) Q:I
- . S I=$O(^OR(100,+ORIFN,8,"A"),-1)
- S X=+$P($G(^OR(100,+ORIFN,8,I,0)),U,3) S:X'=ORNP $P(^(0),U,3)=ORNP
- S X=+$P($P(RXE,"|",3),U,4)
- I X,X'=+$$VALUE(ORDER,"DRUG") D RESP^ORCSAVE2(ORDER,"OR GTX DISPENSE DRUG",X)
- S RXO=$$RXO^ORMPS D:RXO
- . N I,J S J=$$UNESC^ORMPS2($P(RXO,"|",21))
- . I $TR(J," ")'=$TR($$VALUE(ORDER,"INDICATION")," ") D RESP^ORCSAVE2(ORDER,"OR GTX INDICATION",J)
- ;P*413
- D CLNUPD
- I $G(ORCAT)="I" D Q
- . S X=$P($P($P(RXE,"|",2),U,2),"&",2)
- . I X'=$$VALUE(ORDER,"ADMIN") D RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES",X)
- . ;SCHEDULE TYPE
- . S X=$P($P(RXE,"|",2),U,7)
- . I X'=$$VALUE(ORDER,"SCHTYPE") D RESP^ORCSAVE2(ORDER,"OR GTX SCHEDULE TYPE",X)
- . I $S(X="P":1,X="O":1,X="OC":1,1:0) D
- . .D RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES","")
- I $G(PKGIFN)'["N" D ;Rx only, not non-VA
- . S X=$P(RXE,"|",23) S:$E(X)="D" X=+$E(X,2,99)
- . I +X'=+$$VALUE(ORDER,"SUPPLY") D RESP^ORCSAVE2(ORDER,"OR GTX DAYS SUPPLY",X)
- . I $P(ZRX,"|",5)'=$$VALUE(ORDER,"PICKUP") D RESP^ORCSAVE2(ORDER,"OR GTX ROUTING",$P(ZRX,"|",5))
- . I +$P(ZRX,"|",9)'=+$$VALUE(ORDER,"TITR") D RESP^ORCSAVE2(ORDER,"OR GTX TITRATION",+$P(ZRX,"|",9))
- . S NTE=$$NTE(7),PI=+$O(^OR(100,ORDER,4.5,"ID","PI",0))
- . I NTE,PI,$$NTXT(NTE)'=$$VALTXT(ORDER,PI) D
- .. N CNT K ^OR(100,ORDER,4.5,PI,2)
- .. S CNT=1,^OR(100,ORDER,4.5,PI,2,1,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4))
- .. S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I<1 S CNT=CNT+1,^OR(100,ORDER,4.5,PI,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
- .. S ^OR(100,ORDER,4.5,PI,2,0)="^^"_CNT_U_CNT_U_DT_U
- . ;update SIG ;p547
- . N SIG
- . S NTE=$$NTE(21),SIG=+$O(^OR(100,ORDER,4.5,"ID","SIG",0))
- . I NTE,SIG,$$NTXT(NTE)'=$$VALTXT(ORDER,SIG) D
- .. N CNT K ^OR(100,ORDER,4.5,SIG,2)
- .. S CNT=1,^OR(100,ORDER,4.5,SIG,2,1,0)=$$UNESC^ORMPS2($P(@ORMSG@(NTE),"|",4))
- .. S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I<1 S CNT=CNT+1,^OR(100,ORDER,4.5,SIG,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
- .. S ^OR(100,ORDER,4.5,SIG,2,0)="^^"_CNT_U_CNT_U_DT_U
- S ZSC=$$ZSC I ZSC,$P(ZSC,"|",2)'?2.3U S ^OR(100,ORDER,5)=$TR($P(ZSC,"|",2,7),"|","^") ;1 or 0 instead of [N]SC
- Q
- ;
- CLNUPD ;-- Update, if Clinic order ;p413
- N ORDIALOG,DIALOG,DA,DR,DIE
- S ORDIALOG=$P(^OR(100,+ORIFN,0),U,5) I ORDIALOG="" Q
- S DIALOG="^"_$P(ORDIALOG,";",2)_+ORDIALOG_",0)"
- I $P($G(@DIALOG),U)="PSJ OR CLINIC OE" D
- . S DA=+ORIFN,DR="",DIE="^OR(100,"
- . I +$G(ORL)'=+$P(^OR(100,+ORIFN,0),U,10) S $P(^OR(100,+ORIFN,0),U,10)=ORL
- . I $G(ORAPPT)'=+$P(^OR(100,+ORIFN,0),U,18) S DR="16////"_ORAPPT
- . I DR'="" D ^DIE
- Q
- ;
- VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID
- I '$G(IFN)!('$D(^OR(100,+$G(IFN),0)))!($G(ID)="") Q ""
- N I,Y S I=0,Y="" S:'$G(INST) INST=1
- F S I=$O(^OR(100,IFN,4.5,"ID",ID,I)) Q:I'>0 I $P($G(^OR(100,IFN,4.5,+I,0)),U,3)=INST S Y=$G(^(1)) Q
- Q Y
- ;
- VALTXT(IFN,ID) ; -- Return string of text for prompt ID [assumes single instance]
- ; ID may be identifier name or Response IEN
- N Y,DA,I S IFN=+$G(IFN),ID=$G(ID)
- S DA=$S($G(ID):+ID,$L(ID):+$O(^OR(100,IFN,4.5,"ID",ID,0)),1:0)
- S I=+$O(^OR(100,IFN,4.5,DA,2,0)),Y=$G(^(I,0))
- F S I=$O(^OR(100,IFN,4.5,DA,2,I)) Q:I<1 S Y=Y_" "_$G(^(I,0))
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMPS3 6773 printed Feb 18, 2025@23:58:40 Page 2
- ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;Jun 18, 2021@08:44:23
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**213,243,413,547,405**;Dec 17, 1997;Build 211
- +2 ;
- PTR(X) ; -- Return ptr to prompt OR GTX X
- +1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
- +2 ;
- PARENT ; -- create parent order for backdoor complex renewals
- +1 ; Expects ORIFN, ORIG, ORDIALOG()
- +2 ;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
- +3 NEW ORIGDAD,ORIFNDAD,HDR
- SET ORIGDAD=$PIECE($GET(^OR(100,ORIG,3)),U,9)
- +4 ;cont if complex
- if ORIGDAD<1
- QUIT
- if $$DOSES^ORCACT4(ORIGDAD)'>1
- QUIT
- +5 SET ORIFNDAD=$PIECE($GET(^OR(100,ORIGDAD,3)),U,6)
- IF ORIFNDAD<1
- Begin DoDot:1
- +6 NEW ORIFN
- DO EN^ORCSAVE
- if ORIFN<1
- QUIT
- +7 SET $PIECE(^OR(100,ORIFN,3),U,5)=ORIGDAD
- SET $PIECE(^(3),U,8)=1
- SET $PIECE(^(3),U,11)=2
- +8 SET $PIECE(^OR(100,ORIGDAD,3),U,6)=ORIFN
- SET ORIFNDAD=ORIFN
- +9 DO RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
- +10 DO SIGSTS^ORCSAVE2(ORIFN,1)
- DO DATES^ORCSAVE2(ORIFN,ORSTRT)
- +11 ;sign children instead
- IF $PIECE(^OR(100,ORIFN,8,1,0),U,4)=2
- SET $PIECE(^(0),U,4)=""
- KILL ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1)
- +12 ;STATUS updated in SN2^ORMPS from child orders
- End DoDot:1
- GOTO P1
- P0 ; -- just add conjunction, new dose if DAD already exists
- +1 NEW INST,DA,PTR,ID,P,I,J,X
- +2 SET INST=$$DOSES^ORCACT4(ORIFNDAD)
- SET DA=$ORDER(^OR(100,ORIFNDAD,4.5,"A"),-1)
- +3 SET PTR=$$PTR("AND/THEN")
- SET ID="CONJ"
- SET DA=DA+1
- +4 SET ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID
- SET ^(1)="A"
- +5 SET ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)=""
- SET INST=INST+1
- +6 FOR P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG"
- Begin DoDot:1
- +7 SET PTR=$$PTR(P)
- if '$LENGTH($GET(ORDIALOG(PTR,1)))
- QUIT
- +8 SET DA=DA+1
- SET ID=$PIECE($GET(^ORD(101.41,PTR,1)),U,3)
- +9 SET ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID
- SET ^(1)=ORDIALOG(PTR,1)
- +10 SET ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
- End DoDot:1
- +11 SET $PIECE(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
- +12 SET P=$$PTR("SIG")
- SET DA=+$ORDER(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
- +13 SET I=+$ORDER(^OR(100,ORIFNDAD,4.5,DA,2,""),-1)
- SET X=$GET(^(I,0))
- if $LENGTH(X)
- SET X=X_" AND"
- SET ^(0)=X
- +14 SET J=0
- FOR
- SET J=$ORDER(^TMP("ORWORD",$JOB,PTR,1,J))
- if J<1
- QUIT
- SET I=I+1
- SET ^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$JOB,PTR,1,J,0)
- +15 SET $PIECE(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
- +16 ; -- rebuild order text w/new SIG
- +17 KILL ^TMP("ORWORD",$JOB,PTR)
- MERGE ^TMP("ORWORD",$JOB,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
- +18 KILL ^OR(100,ORIFNDAD,8,1,.1)
- DO ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
- P1 ; -- set up links
- +1 SET $PIECE(^OR(100,ORIFN,3),U,9)=ORIFNDAD
- +2 SET HDR=$GET(^OR(100,ORIFNDAD,2,0))
- SET ^(0)="^100.002PA^"_ORIFN_U_($PIECE(HDR,U,4)+1)
- SET ^(ORIFN,0)=ORIFN
- +3 QUIT
- +4 ;
- NTE(ID) ; -- Return subscript of NTE|ID segment
- +1 NEW I,SEG,Y
- SET Y=""
- SET I=+RXE
- if '$GET(ID)
- SET ID=21
- +2 FOR
- SET I=$ORDER(@ORMSG@(I))
- if I'>0
- QUIT
- SET SEG=@ORMSG@(I)
- if $EXTRACT(SEG,1,3)="ORC"
- QUIT
- IF $PIECE(SEG,"|",1,2)=("NTE|"_ID)
- SET Y=I
- QUIT
- +3 QUIT Y
- +4 ;
- NTXT(NTE) ; -- Return string of text in ORMSG(NTE)
- +1 NEW Y,I
- SET NTE=+$GET(NTE)
- +2 SET Y=$PIECE($GET(@ORMSG@(NTE)),"|",4)
- SET Y=$$UNESC^ORHLESC(Y)
- +3 SET I=0
- FOR
- SET I=$ORDER(@ORMSG@(NTE,I))
- if I<1
- QUIT
- SET Y=Y_" "_$$UNESC^ORHLESC(@ORMSG@(NTE,I))
- +4 QUIT Y
- +5 ;
- ZSC() ; -- Return subscript of ZSC segment
- +1 NEW I,SEG,Y
- SET Y=""
- SET I=+RXE
- +2 FOR
- SET I=$ORDER(@ORMSG@(I))
- if I'>0
- QUIT
- SET SEG=$EXTRACT(@ORMSG@(I),1,3)
- if SEG="ORC"
- QUIT
- IF SEG="ZSC"
- SET Y=I_U_@ORMSG@(I)
- QUIT
- +3 QUIT Y
- +4 ;
- NUMADDS() ; -- count number of additives to determine type
- +1 NEW CNT,I,X
- SET CNT=0
- SET I=+RXE
- +2 FOR
- SET I=$ORDER(@ORMSG@(I))
- if I'>0
- QUIT
- SET X=@ORMSG@(I)
- if $PIECE(X,"|")="ORC"
- QUIT
- IF $EXTRACT(X,1,6)="RXC|A|"
- SET CNT=CNT+1
- +3 QUIT CNT
- +4 ;
- DURATION(X) ; -- Returns "# units" from U# format
- +1 NEW Y,Y1,Y2
- IF X'?.1U1.N
- QUIT ""
- +2 SET Y1=$EXTRACT(X)
- SET Y2=+$EXTRACT(X,2,$LENGTH(X))
- IF X=+X
- SET Y1="D"
- SET Y2=+X
- +3 SET Y=Y2_" "_$SELECT(Y1="L":"MONTH",Y1="W":"WEEK",Y1="H":"HOUR",Y1="M":"MINUTE",Y1="S":"SECOND",1:"DAY")_$SELECT(Y2>1:"S",1:"")
- +4 QUIT Y
- +5 ;
- UPD ; -- Compare ORMSG to order, update responses [from SC^ORMPS]
- +1 ; Also expects ORIFN,ORNP,ORCAT,OR3,RXE,ZRX,PKGIFN
- +2 NEW X,I,ORDER,ZSC,NTE,PI,RXO
- +3 SET ORDER=+$GET(ORIFN)
- SET I=+$PIECE(ORIFN,";",2)
- IF I<1
- Begin DoDot:1
- +4 SET I=+$PIECE(OR3,U,7)
- if I
- QUIT
- +5 SET I=$ORDER(^OR(100,+ORIFN,8,"A"),-1)
- End DoDot:1
- +6 SET X=+$PIECE($GET(^OR(100,+ORIFN,8,I,0)),U,3)
- if X'=ORNP
- SET $PIECE(^(0),U,3)=ORNP
- +7 SET X=+$PIECE($PIECE(RXE,"|",3),U,4)
- +8 IF X
- IF X'=+$$VALUE(ORDER,"DRUG")
- DO RESP^ORCSAVE2(ORDER,"OR GTX DISPENSE DRUG",X)
- +9 SET RXO=$$RXO^ORMPS
- if RXO
- Begin DoDot:1
- +10 NEW I,J
- SET J=$$UNESC^ORMPS2($PIECE(RXO,"|",21))
- +11 IF $TRANSLATE(J," ")'=$TRANSLATE($$VALUE(ORDER,"INDICATION")," ")
- DO RESP^ORCSAVE2(ORDER,"OR GTX INDICATION",J)
- End DoDot:1
- +12 ;P*413
- +13 DO CLNUPD
- +14 IF $GET(ORCAT)="I"
- Begin DoDot:1
- +15 SET X=$PIECE($PIECE($PIECE(RXE,"|",2),U,2),"&",2)
- +16 IF X'=$$VALUE(ORDER,"ADMIN")
- DO RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES",X)
- +17 ;SCHEDULE TYPE
- +18 SET X=$PIECE($PIECE(RXE,"|",2),U,7)
- +19 IF X'=$$VALUE(ORDER,"SCHTYPE")
- DO RESP^ORCSAVE2(ORDER,"OR GTX SCHEDULE TYPE",X)
- +20 IF $SELECT(X="P":1,X="O":1,X="OC":1,1:0)
- Begin DoDot:2
- +21 DO RESP^ORCSAVE2(ORDER,"OR GTX ADMIN TIMES","")
- End DoDot:2
- End DoDot:1
- QUIT
- +22 ;Rx only, not non-VA
- IF $GET(PKGIFN)'["N"
- Begin DoDot:1
- +23 SET X=$PIECE(RXE,"|",23)
- if $EXTRACT(X)="D"
- SET X=+$EXTRACT(X,2,99)
- +24 IF +X'=+$$VALUE(ORDER,"SUPPLY")
- DO RESP^ORCSAVE2(ORDER,"OR GTX DAYS SUPPLY",X)
- +25 IF $PIECE(ZRX,"|",5)'=$$VALUE(ORDER,"PICKUP")
- DO RESP^ORCSAVE2(ORDER,"OR GTX ROUTING",$PIECE(ZRX,"|",5))
- +26 IF +$PIECE(ZRX,"|",9)'=+$$VALUE(ORDER,"TITR")
- DO RESP^ORCSAVE2(ORDER,"OR GTX TITRATION",+$PIECE(ZRX,"|",9))
- +27 SET NTE=$$NTE(7)
- SET PI=+$ORDER(^OR(100,ORDER,4.5,"ID","PI",0))
- +28 IF NTE
- IF PI
- IF $$NTXT(NTE)'=$$VALTXT(ORDER,PI)
- Begin DoDot:2
- +29 NEW CNT
- KILL ^OR(100,ORDER,4.5,PI,2)
- +30 SET CNT=1
- SET ^OR(100,ORDER,4.5,PI,2,1,0)=$$UNESC^ORMPS2($PIECE(@ORMSG@(NTE),"|",4))
- +31 SET I=0
- FOR
- SET I=$ORDER(@ORMSG@(NTE,I))
- if I<1
- QUIT
- SET CNT=CNT+1
- SET ^OR(100,ORDER,4.5,PI,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
- +32 SET ^OR(100,ORDER,4.5,PI,2,0)="^^"_CNT_U_CNT_U_DT_U
- End DoDot:2
- +33 ;update SIG ;p547
- +34 NEW SIG
- +35 SET NTE=$$NTE(21)
- SET SIG=+$ORDER(^OR(100,ORDER,4.5,"ID","SIG",0))
- +36 IF NTE
- IF SIG
- IF $$NTXT(NTE)'=$$VALTXT(ORDER,SIG)
- Begin DoDot:2
- +37 NEW CNT
- KILL ^OR(100,ORDER,4.5,SIG,2)
- +38 SET CNT=1
- SET ^OR(100,ORDER,4.5,SIG,2,1,0)=$$UNESC^ORMPS2($PIECE(@ORMSG@(NTE),"|",4))
- +39 SET I=0
- FOR
- SET I=$ORDER(@ORMSG@(NTE,I))
- if I<1
- QUIT
- SET CNT=CNT+1
- SET ^OR(100,ORDER,4.5,SIG,2,CNT,0)=$$UNESC^ORMPS2(@ORMSG@(NTE,I))
- +40 SET ^OR(100,ORDER,4.5,SIG,2,0)="^^"_CNT_U_CNT_U_DT_U
- End DoDot:2
- End DoDot:1
- +41 ;1 or 0 instead of [N]SC
- SET ZSC=$$ZSC
- IF ZSC
- IF $PIECE(ZSC,"|",2)'?2.3U
- SET ^OR(100,ORDER,5)=$TRANSLATE($PIECE(ZSC,"|",2,7),"|","^")
- +42 QUIT
- +43 ;
- CLNUPD ;-- Update, if Clinic order ;p413
- +1 NEW ORDIALOG,DIALOG,DA,DR,DIE
- +2 SET ORDIALOG=$PIECE(^OR(100,+ORIFN,0),U,5)
- IF ORDIALOG=""
- QUIT
- +3 SET DIALOG="^"_$PIECE(ORDIALOG,";",2)_+ORDIALOG_",0)"
- +4 IF $PIECE($GET(@DIALOG),U)="PSJ OR CLINIC OE"
- Begin DoDot:1
- +5 SET DA=+ORIFN
- SET DR=""
- SET DIE="^OR(100,"
- +6 IF +$GET(ORL)'=+$PIECE(^OR(100,+ORIFN,0),U,10)
- SET $PIECE(^OR(100,+ORIFN,0),U,10)=ORL
- +7 IF $GET(ORAPPT)'=+$PIECE(^OR(100,+ORIFN,0),U,18)
- SET DR="16////"_ORAPPT
- +8 IF DR'=""
- DO ^DIE
- End DoDot:1
- +9 QUIT
- +10 ;
- VALUE(IFN,ID,INST) ; -- Returns value of prompt by identifier ID
- +1 IF '$GET(IFN)!('$DATA(^OR(100,+$GET(IFN),0)))!($GET(ID)="")
- QUIT ""
- +2 NEW I,Y
- SET I=0
- SET Y=""
- if '$GET(INST)
- SET INST=1
- +3 FOR
- SET I=$ORDER(^OR(100,IFN,4.5,"ID",ID,I))
- if I'>0
- QUIT
- IF $PIECE($GET(^OR(100,IFN,4.5,+I,0)),U,3)=INST
- SET Y=$GET(^(1))
- QUIT
- +4 QUIT Y
- +5 ;
- VALTXT(IFN,ID) ; -- Return string of text for prompt ID [assumes single instance]
- +1 ; ID may be identifier name or Response IEN
- +2 NEW Y,DA,I
- SET IFN=+$GET(IFN)
- SET ID=$GET(ID)
- +3 SET DA=$SELECT($GET(ID):+ID,$LENGTH(ID):+$ORDER(^OR(100,IFN,4.5,"ID",ID,0)),1:0)
- +4 SET I=+$ORDER(^OR(100,IFN,4.5,DA,2,0))
- SET Y=$GET(^(I,0))
- +5 FOR
- SET I=$ORDER(^OR(100,IFN,4.5,DA,2,I))
- if I<1
- QUIT
- SET Y=Y_" "_$GET(^(I,0))
- +6 QUIT Y