- ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:37
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
- EN ; -- process pkg quick order PITEM from $$ITEM
- I '$L(NMSP) G UNKPKG^ORCONVRT
- G:$L($T(@NMSP)) @NMSP
- S NMSP=$E(NMSP,1,4) G:$L($T(@NMSP)) @NMSP
- S NMSP=$E(NMSP,1,2) G:$L($T(@NMSP)) @NMSP
- G UNKPKG^ORCONVRT
- Q
- ;
- OR ; -- Generic text orders
- I TYPE'="A" G OR^ORCONV0
- Q
- ;
- SR ; -- Surgery
- GMRA ; -- Allergies
- Q
- ;
- FH ; -- Dietetics
- I TYPE'="A" G FH^ORCONV2
- Q
- ;
- GMRC ; -- Consults
- Q:TYPE="A" N DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
- I NAME?1"GMRCT".E D G GMRC1
- . S DEFAULT="CONSULT",ORDG=$O(^ORD(100.98,"B","CSLT",0))
- . S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99CON"
- I NAME?1"GMRCR".E D G GMRC1
- . S DEFAULT="REQUEST",ORDG=$O(^ORD(100.98,"B","PROC",0))
- . S FLINK=PITEM_";99PRO"
- G NONSTD^ORCONVRT
- GMRC1 S DEFAULT=$O(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0)) G:'DEFAULT NONSTD^ORCONVRT
- S OI=$O(^ORD(101.43,"ID",FLINK,0)) G:'OI OI^ORCONVRT
- S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
- S PKG=$O(^DIC(9.4,"C","GMRC",0))
- S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
- S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
- K ^ORD(101.41,DITEM,6) S CODE=$G(^ORD(101,PITEM,20))
- D SET^ORCONVRT("ORDERABLE ITEM",OI)
- S Z=$F(CODE,"GMRCFIO=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("CATEGORY",ZZ)
- S Z=$F(CODE,"GMRCURGX=") I Z S Z=+$E(CODE,Z,999),ZZ=$P($P($G(^ORD(101,Z,0)),U)," - ",2),ZZ=+$O(^ORD(101.42,"B",ZZ,0)) D:ZZ SET^ORCONVRT("URGENCY",ZZ)
- S Z=$F(CODE,"GMRCPLZ=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$S(ZZ="Bedside":"B",ZZ="Consultant's Choice":"C",ZZ="Emergency Room":"E",1:"") D:$L(ZZ) SET^ORCONVRT("PLACE OF CONSULTATION",ZZ)
- S ZZ="" I $O(^ORD(101,PITEM,101.0431,0)) S Z="^ORD(101,"_PITEM_",101.0431)" D SET^ORCONVRT("WORD PROCESSING 1",Z) S:$F(CODE,"GMRCREAF=") ZZ="S GMRCREAF=1"
- S:$F(CODE,"GMRCNOPD=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOPD=1"
- S:$F(CODE,"GMRCNOAT=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOAT=1"
- S:$L(ZZ) ^ORD(101.41,DITEM,3)=ZZ ; entry action
- S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- Q
- ;
- GMRV ; -- Vitals
- ; default Vitals dialog = GMRVOR
- Q:TYPE="A" N DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
- S TEXT=$P(^ORD(101,PITEM,0),U,2),CODE=$G(^(20)),VALUE="NOW^^"
- I NAME?1"GMRVORQ"1.N D Q:'Z ;quick order
- . S:$E(TEXT,1,6)="QUICK " TEXT=$E(TEXT,7,999)
- . S Z=$F(CODE,"GMRVANSR=") I 'Z D NONSTD^ORCONVRT Q
- . S VALUE=$P($E(CODE,Z,999),"""",2)
- S Z=$O(^ORD(100.98,"B","V/M",0))_"^V/M",OI=$$ORDITM^ORCONV0(TEXT,Z)
- G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
- S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
- S DEFAULT=+$O(^ORD(101.41,"AB","GMRVOR",0))
- S PKG=+$O(^DIC(9.4,"C","GMRV",0))
- S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
- S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
- S START=$P(VALUE,U),STOP=$P(VALUE,U,2),SCH=$P(VALUE,U,3)
- F Z="START","STOP","SCH" I $E(@Z)="~" S @Z=$E(@Z,2,99) ; strip leading ~
- K ^ORD(101.41,DITEM,6) D SET^ORCONVRT("ORDERABLE ITEM",OI)
- D:$L(START) SET^ORCONVRT("START DATE/TIME",START)
- D:$L(STOP) SET^ORCONVRT("STOP DATE/TIME",STOP)
- D:$L(SCH) SET^ORCONVRT("SCHEDULE",SCH)
- S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- Q
- ;
- LR ; -- Lab
- I TYPE'="A" G LR^ORCONV2
- Q
- ;
- PS ; -- Pharmacy
- Q:TYPE="A" G:NAME'?1"PSJQ".E NONSTD^ORCONVRT K ^TMP("PSJQO",$J)
- D EN^PSSQOC(PITEM) G:'$D(^TMP("PSJQO",$J)) UNABLE^ORCONVRT
- S TYPE=$P($G(^TMP("PSJQO",$J,1)),U,2)
- G IV^ORCONV2:TYPE=1,UD^ORCONV2:TYPE=2
- G UNABLE^ORCONVRT ; unable to map OI/Drug/IV rate or volume
- Q
- ;
- RA ; -- Radiology
- ; default Radiology Order dialog = RA OERR EXAM
- N DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
- Q:TYPE="A" ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
- S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99RAP",CODE=$G(^(20))
- S OI=$O(^ORD(101.43,"ID",FLINK,0))
- G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
- S IMTYPE=$P($G(^ORD(101.43,OI,"RA")),U,3)
- S ORDG=$O(^ORD(100.98,"B",IMTYPE,0)) S:'ORDG ORDG=$O(^ORD(100.98,"B","XRAY",0))
- S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
- S DEFAULT=$O(^ORD(101.41,"AB","RA OERR EXAM",0)),PKG=$O(^DIC(9.4,"C","RA",0))
- S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
- S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
- K ^ORD(101.41,DITEM,6)
- RA1 ; Stuff values for quick order into appropriate prompts
- D SET^ORCONVRT("ORDERABLE ITEM",OI)
- S Z=$F(CODE,"RAILOC=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^RA(79.1,ZZ,0)) SET^ORCONVRT("IMAGING LOCATION",ZZ)
- S Z=$F(CODE,"RARU=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^ORD(101.42,ZZ,0)) SET^ORCONVRT("URGENCY",ZZ)
- S Z=$F(CODE,"RACAT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("CATEGORY",ZZ)
- S Z=$F(CODE,"RAREQDT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("START DATE/TIME",ZZ)
- S Z=$F(CODE,"RAMT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$$UP^XLFSTR(ZZ) D:$L(ZZ) SET^ORCONVRT("MODE OF TRANSPORT",ZZ)
- RA2 ; Skip RAIP - look for generic order instead
- G RAQ:CODE'["RAMOD" ; no modifiers
- S MODS=CODE,INST=0 F S Z=$F(MODS,"RAMOD(") Q:'Z D
- . S MODS=$E(MODS,Z,999),X=+$P(MODS,"=",2)
- . I X,$D(^RAMIS(71.2,X,0)) S INST=INST+1 D SET^ORCONVRT("MODIFIERS",X,INST)
- RAQ S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- Q
- ;
- DG ; -- Registration
- SD ; -- Scheduling
- I TYPE'="A",TYPE'="O" Q ; actions or protocols only
- N X,PKG S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
- S PKG=$P(^ORD(101,PITEM,0),U,12)
- S X=^ORD(101.41,DITEM,0),X=X_"^^A^"_$O(^ORD(100.98,"B","M.A.S.",0))_U_U_PKG,^ORD(101.41,DITEM,0)=X
- S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
- S ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$S($L($G(^ORD(101,PITEM,20))):" "_^(20),1:"")
- S ^ORD(101.41,DITEM,4)=$S($L($G(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONV1 6071 printed Feb 18, 2025@23:55:24 Page 2
- ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:37
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
- EN ; -- process pkg quick order PITEM from $$ITEM
- +1 IF '$LENGTH(NMSP)
- GOTO UNKPKG^ORCONVRT
- +2 if $LENGTH($TEXT(@NMSP))
- GOTO @NMSP
- +3 SET NMSP=$EXTRACT(NMSP,1,4)
- if $LENGTH($TEXT(@NMSP))
- GOTO @NMSP
- +4 SET NMSP=$EXTRACT(NMSP,1,2)
- if $LENGTH($TEXT(@NMSP))
- GOTO @NMSP
- +5 GOTO UNKPKG^ORCONVRT
- +6 QUIT
- +7 ;
- OR ; -- Generic text orders
- +1 IF TYPE'="A"
- GOTO OR^ORCONV0
- +2 QUIT
- +3 ;
- SR ; -- Surgery
- GMRA ; -- Allergies
- +1 QUIT
- +2 ;
- FH ; -- Dietetics
- +1 IF TYPE'="A"
- GOTO FH^ORCONV2
- +2 QUIT
- +3 ;
- GMRC ; -- Consults
- +1 if TYPE="A"
- QUIT
- NEW DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
- +2 IF NAME?1"GMRCT".E
- Begin DoDot:1
- +3 SET DEFAULT="CONSULT"
- SET ORDG=$ORDER(^ORD(100.98,"B","CSLT",0))
- +4 SET FLINK=+$PIECE($GET(^ORD(101,PITEM,5)),U)_";99CON"
- End DoDot:1
- GOTO GMRC1
- +5 IF NAME?1"GMRCR".E
- Begin DoDot:1
- +6 SET DEFAULT="REQUEST"
- SET ORDG=$ORDER(^ORD(100.98,"B","PROC",0))
- +7 SET FLINK=PITEM_";99PRO"
- End DoDot:1
- GOTO GMRC1
- +8 GOTO NONSTD^ORCONVRT
- GMRC1 SET DEFAULT=$ORDER(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0))
- if 'DEFAULT
- GOTO NONSTD^ORCONVRT
- +1 SET OI=$ORDER(^ORD(101.43,"ID",FLINK,0))
- if 'OI
- GOTO OI^ORCONVRT
- +2 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
- if 'DITEM
- GOTO DLG^ORCONVRT
- +3 SET PKG=$ORDER(^DIC(9.4,"C","GMRC",0))
- +4 SET X=^ORD(101.41,DITEM,0)
- SET X=X_"^^Q^"_ORDG_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
- SET ^ORD(101.41,DITEM,0)=X
- +5 if PKG
- SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
- +6 KILL ^ORD(101.41,DITEM,6)
- SET CODE=$GET(^ORD(101,PITEM,20))
- +7 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
- +8 SET Z=$FIND(CODE,"GMRCFIO=")
- IF Z
- SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
- DO SET^ORCONVRT("CATEGORY",ZZ)
- +9 SET Z=$FIND(CODE,"GMRCURGX=")
- IF Z
- SET Z=+$EXTRACT(CODE,Z,999)
- SET ZZ=$PIECE($PIECE($GET(^ORD(101,Z,0)),U)," - ",2)
- SET ZZ=+$ORDER(^ORD(101.42,"B",ZZ,0))
- if ZZ
- DO SET^ORCONVRT("URGENCY",ZZ)
- +10 SET Z=$FIND(CODE,"GMRCPLZ=")
- IF Z
- SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
- SET ZZ=$SELECT(ZZ="Bedside":"B",ZZ="Consultant's Choice":"C",ZZ="Emergency Room":"E",1:"")
- if $LENGTH(ZZ)
- DO SET^ORCONVRT("PLACE OF CONSULTATION",ZZ)
- +11 SET ZZ=""
- IF $ORDER(^ORD(101,PITEM,101.0431,0))
- SET Z="^ORD(101,"_PITEM_",101.0431)"
- DO SET^ORCONVRT("WORD PROCESSING 1",Z)
- if $FIND(CODE,"GMRCREAF=")
- SET ZZ="S GMRCREAF=1"
- +12 if $FIND(CODE,"GMRCNOPD=")
- SET ZZ=ZZ_$SELECT($LENGTH(ZZ):",",1:"S ")_"GMRCNOPD=1"
- +13 if $FIND(CODE,"GMRCNOAT=")
- SET ZZ=ZZ_$SELECT($LENGTH(ZZ):",",1:"S ")_"GMRCNOAT=1"
- +14 ; entry action
- if $LENGTH(ZZ)
- SET ^ORD(101.41,DITEM,3)=ZZ
- +15 if $GET(CNT)
- SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- +16 QUIT
- +17 ;
- GMRV ; -- Vitals
- +1 ; default Vitals dialog = GMRVOR
- +2 if TYPE="A"
- QUIT
- NEW DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
- +3 SET TEXT=$PIECE(^ORD(101,PITEM,0),U,2)
- SET CODE=$GET(^(20))
- SET VALUE="NOW^^"
- +4 ;quick order
- IF NAME?1"GMRVORQ"1.N
- Begin DoDot:1
- +5 if $EXTRACT(TEXT,1,6)="QUICK "
- SET TEXT=$EXTRACT(TEXT,7,999)
- +6 SET Z=$FIND(CODE,"GMRVANSR=")
- IF 'Z
- DO NONSTD^ORCONVRT
- QUIT
- +7 SET VALUE=$PIECE($EXTRACT(CODE,Z,999),"""",2)
- End DoDot:1
- if 'Z
- QUIT
- +8 SET Z=$ORDER(^ORD(100.98,"B","V/M",0))_"^V/M"
- SET OI=$$ORDITM^ORCONV0(TEXT,Z)
- +9 if 'OI
- GOTO OI^ORCONVRT
- if $$INACTIVE^ORCONVRT(OI)
- GOTO OI^ORCONVRT
- +10 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
- if 'DITEM
- GOTO DLG^ORCONVRT
- +11 SET DEFAULT=+$ORDER(^ORD(101.41,"AB","GMRVOR",0))
- +12 SET PKG=+$ORDER(^DIC(9.4,"C","GMRV",0))
- +13 SET X=^ORD(101.41,DITEM,0)
- SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
- SET ^ORD(101.41,DITEM,0)=X
- +14 if PKG
- SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
- +15 SET START=$PIECE(VALUE,U)
- SET STOP=$PIECE(VALUE,U,2)
- SET SCH=$PIECE(VALUE,U,3)
- +16 ; strip leading ~
- FOR Z="START","STOP","SCH"
- IF $EXTRACT(@Z)="~"
- SET @Z=$EXTRACT(@Z,2,99)
- +17 KILL ^ORD(101.41,DITEM,6)
- DO SET^ORCONVRT("ORDERABLE ITEM",OI)
- +18 if $LENGTH(START)
- DO SET^ORCONVRT("START DATE/TIME",START)
- +19 if $LENGTH(STOP)
- DO SET^ORCONVRT("STOP DATE/TIME",STOP)
- +20 if $LENGTH(SCH)
- DO SET^ORCONVRT("SCHEDULE",SCH)
- +21 if $GET(CNT)
- SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- +22 QUIT
- +23 ;
- LR ; -- Lab
- +1 IF TYPE'="A"
- GOTO LR^ORCONV2
- +2 QUIT
- +3 ;
- PS ; -- Pharmacy
- +1 if TYPE="A"
- QUIT
- if NAME'?1"PSJQ".E
- GOTO NONSTD^ORCONVRT
- KILL ^TMP("PSJQO",$JOB)
- +2 DO EN^PSSQOC(PITEM)
- if '$DATA(^TMP("PSJQO",$JOB))
- GOTO UNABLE^ORCONVRT
- +3 SET TYPE=$PIECE($GET(^TMP("PSJQO",$JOB,1)),U,2)
- +4 if TYPE=1
- GOTO IV^ORCONV2
- if TYPE=2
- GOTO UD^ORCONV2
- +5 ; unable to map OI/Drug/IV rate or volume
- GOTO UNABLE^ORCONVRT
- +6 QUIT
- +7 ;
- RA ; -- Radiology
- +1 ; default Radiology Order dialog = RA OERR EXAM
- +2 NEW DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
- +3 ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
- if TYPE="A"
- QUIT
- +4 SET FLINK=+$PIECE($GET(^ORD(101,PITEM,5)),U)_";99RAP"
- SET CODE=$GET(^(20))
- +5 SET OI=$ORDER(^ORD(101.43,"ID",FLINK,0))
- +6 if 'OI
- GOTO OI^ORCONVRT
- if $$INACTIVE^ORCONVRT(OI)
- GOTO OI^ORCONVRT
- +7 SET IMTYPE=$PIECE($GET(^ORD(101.43,OI,"RA")),U,3)
- +8 SET ORDG=$ORDER(^ORD(100.98,"B",IMTYPE,0))
- if 'ORDG
- SET ORDG=$ORDER(^ORD(100.98,"B","XRAY",0))
- +9 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
- if 'DITEM
- GOTO DLG^ORCONVRT
- +10 SET DEFAULT=$ORDER(^ORD(101.41,"AB","RA OERR EXAM",0))
- SET PKG=$ORDER(^DIC(9.4,"C","RA",0))
- +11 SET X=^ORD(101.41,DITEM,0)
- SET X=X_"^^Q^"_ORDG_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
- SET ^ORD(101.41,DITEM,0)=X
- +12 if PKG
- SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
- +13 KILL ^ORD(101.41,DITEM,6)
- RA1 ; Stuff values for quick order into appropriate prompts
- +1 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
- +2 SET Z=$FIND(CODE,"RAILOC=")
- IF Z
- SET ZZ=+$EXTRACT(CODE,Z,999)
- if ZZ&$DATA(^RA(79.1,ZZ,0))
- DO SET^ORCONVRT("IMAGING LOCATION",ZZ)
- +3 SET Z=$FIND(CODE,"RARU=")
- IF Z
- SET ZZ=+$EXTRACT(CODE,Z,999)
- if ZZ&$DATA(^ORD(101.42,ZZ,0))
- DO SET^ORCONVRT("URGENCY",ZZ)
- +4 SET Z=$FIND(CODE,"RACAT=")
- IF Z
- SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
- if $LENGTH(ZZ)
- DO SET^ORCONVRT("CATEGORY",ZZ)
- +5 SET Z=$FIND(CODE,"RAREQDT=")
- IF Z
- SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
- if $LENGTH(ZZ)
- DO SET^ORCONVRT("START DATE/TIME",ZZ)
- +6 SET Z=$FIND(CODE,"RAMT=")
- IF Z
- SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
- SET ZZ=$$UP^XLFSTR(ZZ)
- if $LENGTH(ZZ)
- DO SET^ORCONVRT("MODE OF TRANSPORT",ZZ)
- RA2 ; Skip RAIP - look for generic order instead
- +1 ; no modifiers
- if CODE'["RAMOD"
- GOTO RAQ
- +2 SET MODS=CODE
- SET INST=0
- FOR
- SET Z=$FIND(MODS,"RAMOD(")
- if 'Z
- QUIT
- Begin DoDot:1
- +3 SET MODS=$EXTRACT(MODS,Z,999)
- SET X=+$PIECE(MODS,"=",2)
- +4 IF X
- IF $DATA(^RAMIS(71.2,X,0))
- SET INST=INST+1
- DO SET^ORCONVRT("MODIFIERS",X,INST)
- End DoDot:1
- RAQ if $GET(CNT)
- SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
- +1 QUIT
- +2 ;
- DG ; -- Registration
- SD ; -- Scheduling
- +1 ; actions or protocols only
- IF TYPE'="A"
- IF TYPE'="O"
- QUIT
- +2 NEW X,PKG
- SET DITEM=$$DIALOG^ORCONVRT(PITEM)
- if 'DITEM
- GOTO DLG^ORCONVRT
- +3 SET PKG=$PIECE(^ORD(101,PITEM,0),U,12)
- +4 SET X=^ORD(101.41,DITEM,0)
- SET X=X_"^^A^"_$ORDER(^ORD(100.98,"B","M.A.S.",0))_U_U_PKG
- SET ^ORD(101.41,DITEM,0)=X
- +5 if PKG
- SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
- +6 SET ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$SELECT($LENGTH($GET(^ORD(101,PITEM,20))):" "_^(20),1:"")
- +7 SET ^ORD(101.41,DITEM,4)=$SELECT($LENGTH($GET(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
- +8 QUIT
