- ORCDSD ;SLC/AGP Scheduling Order dialog utilities ;03/19/2019
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,377**;Dec 17, 1997;Build 582
- ;Per VHA Directive 6402, this routine should not be modified.
- Q
- ;
- INTERH ;
- N LIST,NAME
- W !,"Select one of the following:"
- D INTERL(.LIST)
- S NAME="" F S NAME=$O(LIST(NAME)) Q:NAME="" W !," "_NAME
- Q
- INTERL(LIST) ;
- S LIST("WEEKLY")="",LIST("DAILY")=""
- Q
- ;
- INTERV ;
- N NAME,LIST,TMP
- S TMP=$$UP^XLFSTR(X)
- D INTERL(.LIST)
- I $D(LIST(TMP)) Q
- W !!,X_"is an invalid interval",!!
- D INTERH
- W !
- K X
- Q
- ;
- PREREQP(ORPAR) ;
- N CLSTP,CNT,DIV,ENT,ERR,HFAC,HLOCIEN,ILST,INST,X
- S ENT=""
- S HLOCIEN=+$G(ORCLOC) I HLOCIEN>0 D
- .S DIV=$P($G(^SC(HLOCIEN,0)),U,4)
- .S CLSTP=$P($G(^SC(HLOCIEN,0)),U,7)
- .S ENT="LOC.`"_HLOCIEN
- .I +CLSTP>0 S ENT=ENT_U_"CST.`"_CLSTP
- .I +DIV>0 S ENT=ENT_U_"DIV.`"_DIV
- S ENT=$S(ENT'="":ENT_U_"SYS",1:"SYS")
- D GETLST^XPAR(.ORPAR,ENT,"OR SD DIALOG PREREQ","N",.ERR)
- Q
- ;
- PREREQH ;
- N CNT,LIST
- D PREREQP(.LIST)
- I '$D(LIST) W !,"No prerequisites defined"
- W !,"Select from the following:"
- S CNT=0 F S CNT=$O(LIST(CNT)) Q:CNT'>0 D
- .I $P(LIST(CNT),U)="" Q
- .W !," "_$P(LIST(CNT),U)
- Q
- ;
- PREREQN() ;
- N LIST,NUM
- D PREREQP(.LIST)
- I '$D(LIST) Q 0
- S NUM=LIST
- Q NUM
- ;
- PREREQV ;
- N ARRAY,CNT,NODE,LIST,TMP
- S TMP=$$UP^XLFSTR(X)
- D PREREQP(.LIST)
- S CNT=0 F S CNT=$O(LIST(CNT)) Q:CNT'>0 D
- .I $P(LIST(CNT),U)="" Q
- .S ARRAY($$UP^XLFSTR($P(LIST(CNT),U)))=""
- I '$D(ARRAY(TMP)) W !,X_" is not a valid prerequisite" K X Q
- I $G(X)="" W !! D PREREQH
- Q
- ;
- SETSTOP() ;
- N %DT,CIDC,RESULT,OFFSET,X,Y
- S RESULT="T"
- S X=$$VAL^ORCD("CLINICALLY")
- S %DT="T" D ^%DT
- S OFFSET=$$GET^XPAR("SYS","OR SD CIDC STOP OFFSET",1,"E")
- I Y>0 S RESULT=$$FMADD^XLFDT(Y,OFFSET)
- Q RESULT
- ;
- VALCLINC(Y) ;
- ;N IEN
- ;S IEN=$O(^SC("B",X,"")) I IEN'>0 Q 0
- I ("C"'[$P($G(^SC(Y,0)),U,3)!('$$ACTLOC^ORWU(Y))) Q 0
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDSD 1941 printed Jan 18, 2025@03:29:25 Page 2
- ORCDSD ;SLC/AGP Scheduling Order dialog utilities ;03/19/2019
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,377**;Dec 17, 1997;Build 582
- +2 ;Per VHA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- INTERH ;
- +1 NEW LIST,NAME
- +2 WRITE !,"Select one of the following:"
- +3 DO INTERL(.LIST)
- +4 SET NAME=""
- FOR
- SET NAME=$ORDER(LIST(NAME))
- if NAME=""
- QUIT
- WRITE !," "_NAME
- +5 QUIT
- INTERL(LIST) ;
- +1 SET LIST("WEEKLY")=""
- SET LIST("DAILY")=""
- +2 QUIT
- +3 ;
- INTERV ;
- +1 NEW NAME,LIST,TMP
- +2 SET TMP=$$UP^XLFSTR(X)
- +3 DO INTERL(.LIST)
- +4 IF $DATA(LIST(TMP))
- QUIT
- +5 WRITE !!,X_"is an invalid interval",!!
- +6 DO INTERH
- +7 WRITE !
- +8 KILL X
- +9 QUIT
- +10 ;
- PREREQP(ORPAR) ;
- +1 NEW CLSTP,CNT,DIV,ENT,ERR,HFAC,HLOCIEN,ILST,INST,X
- +2 SET ENT=""
- +3 SET HLOCIEN=+$GET(ORCLOC)
- IF HLOCIEN>0
- Begin DoDot:1
- +4 SET DIV=$PIECE($GET(^SC(HLOCIEN,0)),U,4)
- +5 SET CLSTP=$PIECE($GET(^SC(HLOCIEN,0)),U,7)
- +6 SET ENT="LOC.`"_HLOCIEN
- +7 IF +CLSTP>0
- SET ENT=ENT_U_"CST.`"_CLSTP
- +8 IF +DIV>0
- SET ENT=ENT_U_"DIV.`"_DIV
- End DoDot:1
- +9 SET ENT=$SELECT(ENT'="":ENT_U_"SYS",1:"SYS")
- +10 DO GETLST^XPAR(.ORPAR,ENT,"OR SD DIALOG PREREQ","N",.ERR)
- +11 QUIT
- +12 ;
- PREREQH ;
- +1 NEW CNT,LIST
- +2 DO PREREQP(.LIST)
- +3 IF '$DATA(LIST)
- WRITE !,"No prerequisites defined"
- +4 WRITE !,"Select from the following:"
- +5 SET CNT=0
- FOR
- SET CNT=$ORDER(LIST(CNT))
- if CNT'>0
- QUIT
- Begin DoDot:1
- +6 IF $PIECE(LIST(CNT),U)=""
- QUIT
- +7 WRITE !," "_$PIECE(LIST(CNT),U)
- End DoDot:1
- +8 QUIT
- +9 ;
- PREREQN() ;
- +1 NEW LIST,NUM
- +2 DO PREREQP(.LIST)
- +3 IF '$DATA(LIST)
- QUIT 0
- +4 SET NUM=LIST
- +5 QUIT NUM
- +6 ;
- PREREQV ;
- +1 NEW ARRAY,CNT,NODE,LIST,TMP
- +2 SET TMP=$$UP^XLFSTR(X)
- +3 DO PREREQP(.LIST)
- +4 SET CNT=0
- FOR
- SET CNT=$ORDER(LIST(CNT))
- if CNT'>0
- QUIT
- Begin DoDot:1
- +5 IF $PIECE(LIST(CNT),U)=""
- QUIT
- +6 SET ARRAY($$UP^XLFSTR($PIECE(LIST(CNT),U)))=""
- End DoDot:1
- +7 IF '$DATA(ARRAY(TMP))
- WRITE !,X_" is not a valid prerequisite"
- KILL X
- QUIT
- +8 IF $GET(X)=""
- WRITE !!
- DO PREREQH
- +9 QUIT
- +10 ;
- SETSTOP() ;
- +1 NEW %DT,CIDC,RESULT,OFFSET,X,Y
- +2 SET RESULT="T"
- +3 SET X=$$VAL^ORCD("CLINICALLY")
- +4 SET %DT="T"
- DO ^%DT
- +5 SET OFFSET=$$GET^XPAR("SYS","OR SD CIDC STOP OFFSET",1,"E")
- +6 IF Y>0
- SET RESULT=$$FMADD^XLFDT(Y,OFFSET)
- +7 QUIT RESULT
- +8 ;
- VALCLINC(Y) ;
- +1 ;N IEN
- +2 ;S IEN=$O(^SC("B",X,"")) I IEN'>0 Q 0
- +3 IF ("C"'[$PIECE($GET(^SC(Y,0)),U,3)!('$$ACTLOC^ORWU(Y)))
- QUIT 0
- +4 QUIT 1
- +5 ;