- ORCDRA ; SLC/MKB - Utility functions for RA dialogs ;Nov 28, 2023@11:02:32
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,53,95,141,608**;Dec 17, 1997;Build 15
- ;
- ; Reference to EN2^RAO7PC1 supported by ICR #2012
- ; Reference to ^RA(79.2 supported by ICR #2683
- ; Reference to ^RAMIS(71.2 supported by ICR #2419
- ; Reference to EN4^RAO7PC1 supported by ICR #2267
- ; Reference to RA REQUIRE DETAILED supported by ICR# 2725
- ; Reference to RA SUBMIT PROMPT supported by ICR# 2725
- EN ; -- Entry action for RA OERR EXAM order dialog
- D LAST7:$G(ORTAB)="ORDERS"
- ENA N ENT D ITYPE ;enter here for Quick Setup (editor) instead
- S ENT="ALL"_$S($G(ORDIV):"^DIV.`"_ORDIV,1:"")
- S ORBROAD=$$GET^XPAR(ENT,"RA REQUIRE DETAILED",1,"Q")
- Q
- ;
- EX ; -- Exit action for RA OERR EXAM order dialog
- K ORBROAD,ORIMTYPE,ORIMLOC,ORMORE,ORDIV
- Q
- ;
- LAST7 ; -- Display last 7 days of exams for patient
- N IDT,EXDT,EXAM,STS,Y
- Q:$G(ORTYPE)="Q" Q:$G(ORACT)="XX" Q:$G(ORACT)="RN"
- K ^TMP($J,"RAE7") D EN2^RAO7PC1(+ORVP)
- Q:'$O(^TMP($J,"RAE7",+ORVP,0)) S IDT=0 ; no exams
- W !!,"Case # Exams Over the Last 7 Days Exam Date Status of Exam Imaging Loc.",!,"------ -------------------------- --------- -------------- ------------"
- F S IDT=$O(^TMP($J,"RAE7",+ORVP,IDT)) Q:IDT'>0 S EXAM=$G(^(IDT)) D
- . S Y=$P(9999999-$P(IDT,"-"),".") X ^DD("DD")
- . S STS=$P(EXAM,U,3),STS=$S(STS="V":"VERIFIED",STS="R":"RELEASED/UNVER",STS="N":"NO REPORT",STS="P":"PARTIAL",1:"")
- . W !,$E($P(EXAM,U,2),1,9),?10,$E($P(EXAM,U),1,28),?39,Y_" "_STS,?67,$E($P(EXAM,U,5),1,12)
- K ^TMP($J,"RAE7") W !
- Q
- ;
- ITYPE ; -- Select Imaging Type for ordering, sets ORIMTYPE
- N XRAY,DA,DG,DG0,ABBREV,CNT,ITYPE,DIC,X,Y,I,NAME,OI,IFN,ORY
- I $G(ORTYPE)="Q" S ORDG=ORDG_U_$G(^ORD(100.98,+ORDG,0)) G ITQ
- I $G(ORIFN) S DG=+$P(^OR(100,+ORIFN,0),U,11),ORDG=DG_U_$G(^ORD(100.98,DG,0)) G ITQ ; edit
- S XRAY=$O(^ORD(100.98,"B","XRAY",0)),(DA,CNT)=0
- I $G(ORTYPE)="Z",ORDG'=XRAY S ORDG=ORDG_U_$G(^ORD(100.98,+ORDG,0)) G ITQ
- F S DA=$O(^ORD(100.98,XRAY,1,DA)) Q:DA'>0 S DG=$G(^(DA,0)) D
- . S DG0=$G(^ORD(100.98,DG,0)),ABBREV=$P(DG0,U,3)
- . ;I $D(^ORD(101.43,"S."_ABBREV)) S CNT=CNT+1,ITYPE(ABBREV)=DG_U_DG0
- . I $$ACTIVE(ABBREV) S CNT=CNT+1,ITYPE(ABBREV)=DG_U_DG0
- I 'CNT W $C(7),!!,"No active Imaging Types defined!",! H 3 S ORQUIT=1 Q
- I CNT=1 S I=$O(ITYPE("")),ORDG=ITYPE(I) G ITQ
- W !!,"Select one of the following imaging types:"
- S I="" F S I=$O(ITYPE(I)) Q:I="" W !," "_$P(ITYPE(I),U,2)
- S DIC="^RA(79.2,",DIC(0)="AEQMZ",DIC("A")="Select IMAGING TYPE: "
- S DIC("S")="I $D(ITYPE($P(^(0),U,3)))" W !
- D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) S ORQUIT=1 Q
- S ORDG=ITYPE($P(Y(0),U,3))
- ITQ S NAME=$P(ORDG,U,3),OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
- S ORDIALOG(OI,"A")=NAME_" Procedure: ",ORDIALOG(OI,"?")="Enter the "_NAME_" procedure to be ordered for this patient"
- S ITYPE=$P(ORDG,U,4),ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0))
- S ORDIALOG(OI,"D")="S."_ITYPE_";C."_ITYPE
- I ORIMTYPE D ; screen modifiers on ImType
- . N PTR S PTR=$$PTR^ORCD("OR GTX MODIFIERS") Q:'PTR
- . S ORDIALOG(PTR,"S")="I $D(^RAMIS(71.2,""AB"","_ORIMTYPE_",+Y))"
- S ORDIV=$$DIV^ORCDRA1 D EN4^RAO7PC1(ITYPE,"ORY")
- S (IFN,CNT)=0 F S IFN=$O(ORY(IFN)) Q:IFN'>0 S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN ; I $P(ORY(IFN),U,3)=ORDIV
- I '$$GET^XPAR("ALL^DIV.`"_ORDIV,"RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC ; don't present any choices
- E S ORIMLOC=CNT_"^1"
- Q
- ;
- ACTIVE(DG) ; -- Returns 1 or 0, if active OI's exist for DG
- N X,Y,IDX,ROOT,NOW S Y=0
- G:'$L($G(DG)) ACTQ G:'$D(^ORD(101.43,"S."_DG)) ACTQ
- S IDX="^ORD(101.43,""S."_DG_""")",ROOT=$TR(IDX,")",","),NOW=$$NOW^XLFDT
- F S IDX=$Q(@IDX) Q:$E(IDX,1,$L(ROOT))'=ROOT S X=$P(@IDX,U,3) I 'X!(X>NOW) S Y=1 Q ;at least one active orderable in index
- ACTQ Q Y
- ;
- COMMON ; -- Build ORDIALOG(PROMPT,"LIST") of Common Procedures
- N CNT,ITYPE,NAME,DA K ORDIALOG(PROMPT,"LIST")
- S:'$D(ORDG) ORDG=$P(^ORD(101.41,+ORDIALOG,0),U,5),ORDG=ORDG_U_$G(^ORD(100.98,+ORDG,0))
- S ITYPE=$P(^ORD(100.98,+ORDG,0),U,3) Q:'$D(^ORD(101.43,"COMMON",ITYPE))
- S NAME="",CNT=0
- F S NAME=$O(^ORD(101.43,"COMMON",ITYPE,NAME)) Q:NAME="" S DA=$O(^(NAME,0)),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DA_U_NAME
- S ORDIALOG(PROMPT,"LIST")=CNT
- S:CNT $P(ORDIALOG(PROMPT,"?"),";",2)=" select either the number of a common procedure listed above or the name of any "_$$LOW^XLFSTR($P(ORDG,U,2))_" procedure"
- Q
- ;
- LIST ; -- List Common Procedures in ORDIALOG(PROMPT,"LIST") for selection
- N NUM,DA,HALF,DIR,Y Q:'$O(ORDIALOG(PROMPT,"LIST",0))
- S HALF=ORDIALOG(PROMPT,"LIST")\2
- I ORDIALOG(PROMPT,"LIST")\2*2'=ORDIALOG(PROMPT,"LIST") S HALF=HALF+1
- W !!,"Common "_$$LOWER^VALM1($P(ORDG,U,2))_" Procedures: "
- S Y=1 F NUM=1:1:HALF D Q:'+Y
- . S DA=ORDIALOG(PROMPT,"LIST",NUM)
- . W !,$J(NUM,3)_" "_$E($P(ORDIALOG(PROMPT,"LIST",NUM),U,2),1,36)
- . S DA=$G(ORDIALOG(PROMPT,"LIST",NUM+HALF)) Q:'DA
- . W ?40,$J(NUM+HALF,3)_" "_$E($P(ORDIALOG(PROMPT,"LIST",NUM+HALF),U,2),1,36)
- .I (NUM+$G(VALM("TM"))=24)&(NUM'=$S($G(SCR)'=""&($G(ORTAB)="ORDERS"):19,1:20)) S DIR(0)="E" D ^DIR K DIR
- Q
- ;
- BROAD(PROC) ; -- Ck PROC type vs ORBROAD
- Q:'ORBROAD Q:$P($G(^ORD(101.43,+PROC,"RA")),U,2)'="B"
- K DONE W $C(7),!,"You may not select a broad procedure!",!
- Q
- ;
- LKP ; -- Special lookup on [common] procedures
- N ORX,I,J,Z,BEG,END K ORMORE
- I X'[",",X'["-" S Y=$$FIND^ORCDLG2("ORDIALOG("_PROMPT_",""LIST"")",X) D:'$L(Y) DIC^ORCDLG2 Q
- S ORX=X F I=1:1:$L(ORX,",") S X=$P(ORX,",",I) I $L(X) D
- . I 'X S ORMORE=+$G(ORMORE)+1,ORMORE(ORMORE)=U_X Q
- . I X'?1.2N,X'?1.N1"-"1.N Q
- . S BEG=+X,END=+$P(X,"-",2) S:'END END=X
- . F J=BEG:1:END S Z=$G(ORDIALOG(PROMPT,"LIST",J)) S:Z ORMORE=+$G(ORMORE)+1,ORMORE(ORMORE)=Z
- D NEXTPROC
- Q
- ;
- NEXTPROC ; -- Gets next procedure in ORMORE()
- Q:$G(ORDIALOG(PROMPT,INST))
- N I,X S I=$O(ORMORE(0)) I 'I K ORMORE Q
- S X=$G(ORMORE(I)),ORMORE=ORMORE-1 K ORMORE(I)
- W !!,"For "_$P(ORDIALOG(PROMPT,"A"),":")_" "_$P(X,U,2)_":"
- S:X Y=X,ORDIALOG(PROMPT,INST)=+X,EDITONLY=1
- I 'X S X=$P(X,U,2) D DIC^ORCDLG2 S:Y'>0 ORQUIT=1 S:Y>0 ORDIALOG(PROMPT,INST)=+Y,EDITONLY=1
- Q
- GETPAR(ORRESULTS,ORUSER) ;called from JSYSPARM^ORWU, get parameter for use in CPRS GUI
- S ORRESULTS("radiologyFutureDateLimit")=$$GET^XPAR("ALL","ORCDRA FUTURE DATE LIMIT",1,"I")
- Q
- ;
- DATEDSRD ;--validates date and enforces any associated parameters
- ;called from RA OERR EXAM, Date Desired POST-SELECTION ACTION
- Q:$G(ORTYPE)'="Z"
- N X,Y,%DT,FUTDAYS,FUTDATE S X=$G(ORDIALOG(PROMPT,INST)),%DT="X" I $L(X) D ^%DT S:Y>0 ORDATE=$P(Y,".")
- S FUTDAYS=$$GET^XPAR("PKG","ORCDRA FUTURE DATE LIMIT",1,"I") S:$G(FUTDAYS)>0 FUTDATE=$$FMADD^XLFDT(DT,FUTDAYS)
- I ORDATE>FUTDATE K DONE W $C(7),!,"Response cannot be more than "_FUTDAYS_" days in the future."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDRA 6793 printed Jan 18, 2025@03:29:23 Page 2
- ORCDRA ; SLC/MKB - Utility functions for RA dialogs ;Nov 28, 2023@11:02:32
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,53,95,141,608**;Dec 17, 1997;Build 15
- +2 ;
- +3 ; Reference to EN2^RAO7PC1 supported by ICR #2012
- +4 ; Reference to ^RA(79.2 supported by ICR #2683
- +5 ; Reference to ^RAMIS(71.2 supported by ICR #2419
- +6 ; Reference to EN4^RAO7PC1 supported by ICR #2267
- +7 ; Reference to RA REQUIRE DETAILED supported by ICR# 2725
- +8 ; Reference to RA SUBMIT PROMPT supported by ICR# 2725
- EN ; -- Entry action for RA OERR EXAM order dialog
- +1 if $GET(ORTAB)="ORDERS"
- DO LAST7
- ENA ;enter here for Quick Setup (editor) instead
- NEW ENT
- DO ITYPE
- +1 SET ENT="ALL"_$SELECT($GET(ORDIV):"^DIV.`"_ORDIV,1:"")
- +2 SET ORBROAD=$$GET^XPAR(ENT,"RA REQUIRE DETAILED",1,"Q")
- +3 QUIT
- +4 ;
- EX ; -- Exit action for RA OERR EXAM order dialog
- +1 KILL ORBROAD,ORIMTYPE,ORIMLOC,ORMORE,ORDIV
- +2 QUIT
- +3 ;
- LAST7 ; -- Display last 7 days of exams for patient
- +1 NEW IDT,EXDT,EXAM,STS,Y
- +2 if $GET(ORTYPE)="Q"
- QUIT
- if $GET(ORACT)="XX"
- QUIT
- if $GET(ORACT)="RN"
- QUIT
- +3 KILL ^TMP($JOB,"RAE7")
- DO EN2^RAO7PC1(+ORVP)
- +4 ; no exams
- if '$ORDER(^TMP($JOB,"RAE7",+ORVP,0))
- QUIT
- SET IDT=0
- +5 WRITE !!,"Case # Exams Over the Last 7 Days Exam Date Status of Exam Imaging Loc.",!,"------ -------------------------- --------- -------------- ------------"
- +6 FOR
- SET IDT=$ORDER(^TMP($JOB,"RAE7",+ORVP,IDT))
- if IDT'>0
- QUIT
- SET EXAM=$GET(^(IDT))
- Begin DoDot:1
- +7 SET Y=$PIECE(9999999-$PIECE(IDT,"-"),".")
- XECUTE ^DD("DD")
- +8 SET STS=$PIECE(EXAM,U,3)
- SET STS=$SELECT(STS="V":"VERIFIED",STS="R":"RELEASED/UNVER",STS="N":"NO REPORT",STS="P":"PARTIAL",1:"")
- +9 WRITE !,$EXTRACT($PIECE(EXAM,U,2),1,9),?10,$EXTRACT($PIECE(EXAM,U),1,28),?39,Y_" "_STS,?67,$EXTRACT($PIECE(EXAM,U,5),1,12)
- End DoDot:1
- +10 KILL ^TMP($JOB,"RAE7")
- WRITE !
- +11 QUIT
- +12 ;
- ITYPE ; -- Select Imaging Type for ordering, sets ORIMTYPE
- +1 NEW XRAY,DA,DG,DG0,ABBREV,CNT,ITYPE,DIC,X,Y,I,NAME,OI,IFN,ORY
- +2 IF $GET(ORTYPE)="Q"
- SET ORDG=ORDG_U_$GET(^ORD(100.98,+ORDG,0))
- GOTO ITQ
- +3 ; edit
- IF $GET(ORIFN)
- SET DG=+$PIECE(^OR(100,+ORIFN,0),U,11)
- SET ORDG=DG_U_$GET(^ORD(100.98,DG,0))
- GOTO ITQ
- +4 SET XRAY=$ORDER(^ORD(100.98,"B","XRAY",0))
- SET (DA,CNT)=0
- +5 IF $GET(ORTYPE)="Z"
- IF ORDG'=XRAY
- SET ORDG=ORDG_U_$GET(^ORD(100.98,+ORDG,0))
- GOTO ITQ
- +6 FOR
- SET DA=$ORDER(^ORD(100.98,XRAY,1,DA))
- if DA'>0
- QUIT
- SET DG=$GET(^(DA,0))
- Begin DoDot:1
- +7 SET DG0=$GET(^ORD(100.98,DG,0))
- SET ABBREV=$PIECE(DG0,U,3)
- +8 ;I $D(^ORD(101.43,"S."_ABBREV)) S CNT=CNT+1,ITYPE(ABBREV)=DG_U_DG0
- +9 IF $$ACTIVE(ABBREV)
- SET CNT=CNT+1
- SET ITYPE(ABBREV)=DG_U_DG0
- End DoDot:1
- +10 IF 'CNT
- WRITE $CHAR(7),!!,"No active Imaging Types defined!",!
- HANG 3
- SET ORQUIT=1
- QUIT
- +11 IF CNT=1
- SET I=$ORDER(ITYPE(""))
- SET ORDG=ITYPE(I)
- GOTO ITQ
- +12 WRITE !!,"Select one of the following imaging types:"
- +13 SET I=""
- FOR
- SET I=$ORDER(ITYPE(I))
- if I=""
- QUIT
- WRITE !," "_$PIECE(ITYPE(I),U,2)
- +14 SET DIC="^RA(79.2,"
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select IMAGING TYPE: "
- +15 SET DIC("S")="I $D(ITYPE($P(^(0),U,3)))"
- WRITE !
- +16 DO ^DIC
- IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
- SET ORQUIT=1
- QUIT
- +17 SET ORDG=ITYPE($PIECE(Y(0),U,3))
- ITQ SET NAME=$PIECE(ORDG,U,3)
- SET OI=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
- +1 SET ORDIALOG(OI,"A")=NAME_" Procedure: "
- SET ORDIALOG(OI,"?")="Enter the "_NAME_" procedure to be ordered for this patient"
- +2 SET ITYPE=$PIECE(ORDG,U,4)
- SET ORIMTYPE=$ORDER(^RA(79.2,"C",ITYPE,0))
- +3 SET ORDIALOG(OI,"D")="S."_ITYPE_";C."_ITYPE
- +4 ; screen modifiers on ImType
- IF ORIMTYPE
- Begin DoDot:1
- +5 NEW PTR
- SET PTR=$$PTR^ORCD("OR GTX MODIFIERS")
- if 'PTR
- QUIT
- +6 SET ORDIALOG(PTR,"S")="I $D(^RAMIS(71.2,""AB"","_ORIMTYPE_",+Y))"
- End DoDot:1
- +7 SET ORDIV=$$DIV^ORCDRA1
- DO EN4^RAO7PC1(ITYPE,"ORY")
- +8 ; I $P(ORY(IFN),U,3)=ORDIV
- SET (IFN,CNT)=0
- FOR
- SET IFN=$ORDER(ORY(IFN))
- if IFN'>0
- QUIT
- SET CNT=CNT+1
- SET ORIMLOC(CNT)=ORY(IFN)
- SET ORIMLOC("B",$PIECE(ORY(IFN),U,2))=IFN
- +9 ; don't present any choices
- IF '$$GET^XPAR("ALL^DIV.`"_ORDIV,"RA SUBMIT PROMPT",1,"Q")
- IF CNT>1
- KILL ORIMLOC
- +10 IF '$TEST
- SET ORIMLOC=CNT_"^1"
- +11 QUIT
- +12 ;
- ACTIVE(DG) ; -- Returns 1 or 0, if active OI's exist for DG
- +1 NEW X,Y,IDX,ROOT,NOW
- SET Y=0
- +2 if '$LENGTH($GET(DG))
- GOTO ACTQ
- if '$DATA(^ORD(101.43,"S."_DG))
- GOTO ACTQ
- +3 SET IDX="^ORD(101.43,""S."_DG_""")"
- SET ROOT=$TRANSLATE(IDX,")",",")
- SET NOW=$$NOW^XLFDT
- +4 ;at least one active orderable in index
- FOR
- SET IDX=$QUERY(@IDX)
- if $EXTRACT(IDX,1,$LENGTH(ROOT))'=ROOT
- QUIT
- SET X=$PIECE(@IDX,U,3)
- IF 'X!(X>NOW)
- SET Y=1
- QUIT
- ACTQ QUIT Y
- +1 ;
- COMMON ; -- Build ORDIALOG(PROMPT,"LIST") of Common Procedures
- +1 NEW CNT,ITYPE,NAME,DA
- KILL ORDIALOG(PROMPT,"LIST")
- +2 if '$DATA(ORDG)
- SET ORDG=$PIECE(^ORD(101.41,+ORDIALOG,0),U,5)
- SET ORDG=ORDG_U_$GET(^ORD(100.98,+ORDG,0))
- +3 SET ITYPE=$PIECE(^ORD(100.98,+ORDG,0),U,3)
- if '$DATA(^ORD(101.43,"COMMON",ITYPE))
- QUIT
- +4 SET NAME=""
- SET CNT=0
- +5 FOR
- SET NAME=$ORDER(^ORD(101.43,"COMMON",ITYPE,NAME))
- if NAME=""
- QUIT
- SET DA=$ORDER(^(NAME,0))
- SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=DA_U_NAME
- +6 SET ORDIALOG(PROMPT,"LIST")=CNT
- +7 if CNT
- SET $PIECE(ORDIALOG(PROMPT,"?"),";",2)=" select either the number of a common procedure listed above or the name of any "_$$LOW^XLFSTR($PIECE(ORDG,U,2))_" procedure"
- +8 QUIT
- +9 ;
- LIST ; -- List Common Procedures in ORDIALOG(PROMPT,"LIST") for selection
- +1 NEW NUM,DA,HALF,DIR,Y
- if '$ORDER(ORDIALOG(PROMPT,"LIST",0))
- QUIT
- +2 SET HALF=ORDIALOG(PROMPT,"LIST")\2
- +3 IF ORDIALOG(PROMPT,"LIST")\2*2'=ORDIALOG(PROMPT,"LIST")
- SET HALF=HALF+1
- +4 WRITE !!,"Common "_$$LOWER^VALM1($PIECE(ORDG,U,2))_" Procedures: "
- +5 SET Y=1
- FOR NUM=1:1:HALF
- Begin DoDot:1
- +6 SET DA=ORDIALOG(PROMPT,"LIST",NUM)
- +7 WRITE !,$JUSTIFY(NUM,3)_" "_$EXTRACT($PIECE(ORDIALOG(PROMPT,"LIST",NUM),U,2),1,36)
- +8 SET DA=$GET(ORDIALOG(PROMPT,"LIST",NUM+HALF))
- if 'DA
- QUIT
- +9 WRITE ?40,$JUSTIFY(NUM+HALF,3)_" "_$EXTRACT($PIECE(ORDIALOG(PROMPT,"LIST",NUM+HALF),U,2),1,36)
- +10 IF (NUM+$GET(VALM("TM"))=24)&(NUM'=$SELECT($GET(SCR)'=""&($GET(ORTAB)="ORDERS"):19,1:20))
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- if '+Y
- QUIT
- +11 QUIT
- +12 ;
- BROAD(PROC) ; -- Ck PROC type vs ORBROAD
- +1 if 'ORBROAD
- QUIT
- if $PIECE($GET(^ORD(101.43,+PROC,"RA")),U,2)'="B"
- QUIT
- +2 KILL DONE
- WRITE $CHAR(7),!,"You may not select a broad procedure!",!
- +3 QUIT
- +4 ;
- LKP ; -- Special lookup on [common] procedures
- +1 NEW ORX,I,J,Z,BEG,END
- KILL ORMORE
- +2 IF X'[","
- IF X'["-"
- SET Y=$$FIND^ORCDLG2("ORDIALOG("_PROMPT_",""LIST"")",X)
- if '$LENGTH(Y)
- DO DIC^ORCDLG2
- QUIT
- +3 SET ORX=X
- FOR I=1:1:$LENGTH(ORX,",")
- SET X=$PIECE(ORX,",",I)
- IF $LENGTH(X)
- Begin DoDot:1
- +4 IF 'X
- SET ORMORE=+$GET(ORMORE)+1
- SET ORMORE(ORMORE)=U_X
- QUIT
- +5 IF X'?1.2N
- IF X'?1.N1"-"1.N
- QUIT
- +6 SET BEG=+X
- SET END=+$PIECE(X,"-",2)
- if 'END
- SET END=X
- +7 FOR J=BEG:1:END
- SET Z=$GET(ORDIALOG(PROMPT,"LIST",J))
- if Z
- SET ORMORE=+$GET(ORMORE)+1
- SET ORMORE(ORMORE)=Z
- End DoDot:1
- +8 DO NEXTPROC
- +9 QUIT
- +10 ;
- NEXTPROC ; -- Gets next procedure in ORMORE()
- +1 if $GET(ORDIALOG(PROMPT,INST))
- QUIT
- +2 NEW I,X
- SET I=$ORDER(ORMORE(0))
- IF 'I
- KILL ORMORE
- QUIT
- +3 SET X=$GET(ORMORE(I))
- SET ORMORE=ORMORE-1
- KILL ORMORE(I)
- +4 WRITE !!,"For "_$PIECE(ORDIALOG(PROMPT,"A"),":")_" "_$PIECE(X,U,2)_":"
- +5 if X
- SET Y=X
- SET ORDIALOG(PROMPT,INST)=+X
- SET EDITONLY=1
- +6 IF 'X
- SET X=$PIECE(X,U,2)
- DO DIC^ORCDLG2
- if Y'>0
- SET ORQUIT=1
- if Y>0
- SET ORDIALOG(PROMPT,INST)=+Y
- SET EDITONLY=1
- +7 QUIT
- GETPAR(ORRESULTS,ORUSER) ;called from JSYSPARM^ORWU, get parameter for use in CPRS GUI
- +1 SET ORRESULTS("radiologyFutureDateLimit")=$$GET^XPAR("ALL","ORCDRA FUTURE DATE LIMIT",1,"I")
- +2 QUIT
- +3 ;
- DATEDSRD ;--validates date and enforces any associated parameters
- +1 ;called from RA OERR EXAM, Date Desired POST-SELECTION ACTION
- +2 if $GET(ORTYPE)'="Z"
- QUIT
- +3 NEW X,Y,%DT,FUTDAYS,FUTDATE
- SET X=$GET(ORDIALOG(PROMPT,INST))
- SET %DT="X"
- IF $LENGTH(X)
- DO ^%DT
- if Y>0
- SET ORDATE=$PIECE(Y,".")
- +4 SET FUTDAYS=$$GET^XPAR("PKG","ORCDRA FUTURE DATE LIMIT",1,"I")
- if $GET(FUTDAYS)>0
- SET FUTDATE=$$FMADD^XLFDT(DT,FUTDAYS)
- +5 IF ORDATE>FUTDATE
- KILL DONE
- WRITE $CHAR(7),!,"Response cannot be more than "_FUTDAYS_" days in the future."
- +6 QUIT