Routine: ORWDSD1

ORWDSD1 ;SLC/AGP - Return to Clinic Calls for Windows Dialog ;03/19/2019

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,377**;Dec 17, 1997;Build 582

ODSLCT(LST,DFN,LOC) ; return default lists for dialog

 N ILST S ILST=0

 S ILST=ILST+1,LST(ILST)="~ShortList"  D SHORT

 ;S ILST=ILST+1,LST(ILST)="~Clinic" D CLINIC(.LST,.ILST,DFN,LOC)

 ;S ILST=ILST+1,LST(ILST)="~Provider" D PROVIDER(.LST,.ILST,DFN,LOC)

 ;S ILST=ILST+1,LST(ILST)="~Interval" D INTERVAL(.LST,.ILST,DFN,LOC)

 S ILST=ILST+1,LST(ILST)="~PreReq" D PREREQ(.LST,.ILST,DFN,LOC)

 ;S ILST=ILST+1,LST(ILST)="~Offset" D OFFSET(.LST,.ILST,DFN,LOC)

 S ILST=ILST+1,LST(ILST)="~Info" D INFO(.LST,.ILST,DFN,LOC)

CLINIC(LST,ILST,DFN,LOC) ;

 N CLST,CNT,FOUND,LCNT,IEN,NAME,NODE,TMP

 S NAME="",FOUND=0

 I LOC>0 D

 .S NODE=$G(^SC(LOC,0)) I $P(NODE,U,3)'="C" Q

 .S NAME=$P(NODE,U) I $L(NAME)<3 S TMP=NAME Q

 .S TMP=$E(NAME,1,($L(NAME)-1))

 I $G(TMP)="" Q

 D NEWLOC^ORWU1(.CLST,TMP,1)

 S CNT=0,LCNT=0 F  S CNT=$O(CLST(CNT)) Q:CNT'>0  D

 .S LCNT=CNT

 .I $P(CLST(CNT),U)=LOC,NAME'="" S ILST=ILST+1,LST(ILST)="d"_CLST(CNT),FOUND=1,ILST=ILST+1,LST(ILST)="i"_CLST(CNT) Q

 .S ILST=ILST+1,LST(ILST)="i"_CLST(CNT)

 I FOUND=0,NAME'="" S ILST=ILST+1,LST(ILST)="d"_LOC_U_NAME,ILST=ILST+1,LST(ILST)="i"_LOC_U_NAME

GETINFO(LST,HLOCIEN,WHAT) ;

 N CLSTP,CNT,DIV,ENT,ERR,HFAC,ILST,INST,ORPAR

 S DIV=$P($G(^SC(HLOCIEN,0)),U,4)

 ;S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)

 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=ENT_U_"SYS"

 I WHAT="INFO" D GETWP^XPAR(.ORPAR,ENT,"OR SD ADDITIONAL INFORMATION",,.ERR)

 I WHAT="PRE" D GETLST^XPAR(.ORPAR,ENT,"OR SD DIALOG PREREQ","N",.ERR)

 S CNT=0,ILST=0 F  S CNT=$O(ORPAR(CNT)) Q:CNT'>0  D

 .I WHAT="INFO" S ILST=ILST+1,LST(ILST)=ORPAR(CNT,0) Q

 .S ILST=ILST+1,LST(ILST)=$P(ORPAR(CNT),U,2)

INFO(LST,ILST,DFN,LOC) ;

 N CNT,ENT,ERR,ORPAR,SYSONLY

 I '$$SYSONLY("OR SD ADDITIONAL INFORMATION") Q

 ;D ENVAL^XPAR(.ORPAR,"OR SD ADDITIONAL INFORMATION","",.ERR)

 ;S ENT="" F  S ENT=$O(ORPAR(ENT)) Q:ENT=""!(SYSONLY=0)  S:ENT'["DIC(4.2" SYSONLY=0

 ;I SYSONLY=0 Q

 K ORPAR

 D GETWP^XPAR(.ORPAR,"SYS","OR SD ADDITIONAL INFORMATION",,.ERR)

 S CNT=0 F  S CNT=$O(ORPAR(CNT)) Q:CNT'>0  D

 .S ILST=ILST+1,LST(ILST)="t"_ORPAR(CNT,0)

INTERVAL(LST,ILST,DFN,LOC) ;

 S ILST=ILST+1,LST(ILST)="id^Daily"

 S ILST=ILST+1,LST(ILST)="iw^Weekly"

OFFSET(LST,ILST,DFN,LOC) ;

 N OFFSET

 S OFFSET=$$GET^XPAR("SYS","OR SD CIDC STOP OFFSET",1,"E")

 I OFFSET'>0 S OFFSET=30

 S ILST=ILST+1,LST(ILST)="i"_OFFSET_U_OFFSET

PREREQ(LST,ILST,DFN,LOC) ;

 N ORPAR,X

 I '$$SYSONLY("OR SD DIALOG PREREQ") Q

 D GETLST^XPAR(.ORPAR,"SYS","OR SD DIALOG PREREQ","N",.ERR)

 ;D PREREQP^ORCDSD(.PREREQS)

 S X=0 F  S X=$O(ORPAR(X)) Q:X'>0  I $G(ORPAR(X))'="" S ILST=ILST+1,LST(ILST)="i"_$G(ORPAR(X))

PROVIDER(LST,ILST,DFN,LOC) ;

 N CNT,PLST

 D NEWPERS^ORWU(.PLST,"",1,"PROVIDER",DT,0,"")

 S CNT=0 F  S CNT=$O(PLST(CNT)) Q:CNT'>0  S ILST=ILST+1,LST(ILST)="i"_PLST(CNT)

SHORT ; from DLGSLCT, get short list of med quick orders

 N I,X,TMP

 S X="CSDAM"

 D GETQLST^ORWDXQ(.TMP,X,"iQ")

 S I=0 F  S I=$O(TMP(I)) Q:'I  S ILST=ILST+1,LST(ILST)=TMP(I)

RTC ;

 N INT,NUM,PROMPT

 ;S PROMPT=$O(^ORD(101.41,"AB","OR GTX STOP DATE",0))

 ;S ORDIALOG(PROMPT,1)=$$SETSTOP^ORCDSD()

 ;get number of appointments and interval

 S PROMPT=$O(^ORD(101.41,"AB","OR GTX APPT NUM",0))

 S NUM=$G(ORDIALOG(PROMPT,1))

 S PROMPT=$O(^ORD(101.41,"AB","OR GTX SCH INTERVAL",0))

 S INT=$G(ORDIALOG(PROMPT,1))

 ;check that apppointment and interval match

 I NUM>1,INT="" S AUTOACK=0 Q

 I INT'="",NUM=1 S AUTOACK=0 Q

SYSONLY(PARAM) ;

 N ERR,SYSONLY

 S SYSONLY=1

 D ENVAL^XPAR(.ORPAR,PARAM,"",.ERR)

 S ENT="" F  S ENT=$O(ORPAR(ENT)) Q:ENT=""!(SYSONLY=0)  S:ENT'["DIC(4.2" SYSONLY=0

 Q SYSONLY

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDSD1   3924     printed  Oct 16, 2024@18:36:22                                                                                                                                                                                                     Page 2

ORWDSD1   ;SLC/AGP - Return to Clinic Calls for Windows Dialog ;03/19/2019

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,377**;Dec 17, 1997;Build 582

 +2       ;

ODSLCT(LST,DFN,LOC) ; return default lists for dialog

 +1        NEW ILST

           SET ILST=0

 +2        SET ILST=ILST+1

           SET LST(ILST)="~ShortList"

           DO SHORT

 +3       ;S ILST=ILST+1,LST(ILST)="~Clinic" D CLINIC(.LST,.ILST,DFN,LOC)

 +4       ;S ILST=ILST+1,LST(ILST)="~Provider" D PROVIDER(.LST,.ILST,DFN,LOC)

 +5       ;S ILST=ILST+1,LST(ILST)="~Interval" D INTERVAL(.LST,.ILST,DFN,LOC)

 +6        SET ILST=ILST+1

           SET LST(ILST)="~PreReq"

           DO PREREQ(.LST,.ILST,DFN,LOC)

 +7       ;S ILST=ILST+1,LST(ILST)="~Offset" D OFFSET(.LST,.ILST,DFN,LOC)

 +8        SET ILST=ILST+1

           SET LST(ILST)="~Info"

           DO INFO(.LST,.ILST,DFN,LOC)

 +9        QUIT

 +10      ;

CLINIC(LST,ILST,DFN,LOC) ;

 +1        NEW CLST,CNT,FOUND,LCNT,IEN,NAME,NODE,TMP

 +2       ;

 +3        SET NAME=""

           SET FOUND=0

 +4        IF LOC>0

               Begin DoDot:1

 +5                SET NODE=$GET(^SC(LOC,0))

                   IF $PIECE(NODE,U,3)'="C"

                       QUIT

 +6                SET NAME=$PIECE(NODE,U)

                   IF $LENGTH(NAME)<3

                       SET TMP=NAME

                       QUIT

 +7                SET TMP=$EXTRACT(NAME,1,($LENGTH(NAME)-1))

               End DoDot:1

 +8        IF $GET(TMP)=""

               QUIT

 +9        DO NEWLOC^ORWU1(.CLST,TMP,1)

 +10       SET CNT=0

           SET LCNT=0

FOR

               SET CNT=$ORDER(CLST(CNT))

               if CNT'>0

                   QUIT

               Begin DoDot:1

 +11               SET LCNT=CNT

 +12               IF $PIECE(CLST(CNT),U)=LOC

                       IF NAME'=""

                           SET ILST=ILST+1

                           SET LST(ILST)="d"_CLST(CNT)

                           SET FOUND=1

                           SET ILST=ILST+1

                           SET LST(ILST)="i"_CLST(CNT)

                           QUIT

 +13               SET ILST=ILST+1

                   SET LST(ILST)="i"_CLST(CNT)

               End DoDot:1

 +14       IF FOUND=0

               IF NAME'=""

                   SET ILST=ILST+1

                   SET LST(ILST)="d"_LOC_U_NAME

                   SET ILST=ILST+1

                   SET LST(ILST)="i"_LOC_U_NAME

 +15       QUIT

 +16      ;

GETINFO(LST,HLOCIEN,WHAT) ;

 +1        NEW CLSTP,CNT,DIV,ENT,ERR,HFAC,ILST,INST,ORPAR

 +2        SET DIV=$PIECE($GET(^SC(HLOCIEN,0)),U,4)

 +3       ;S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)

 +4        SET CLSTP=$PIECE($GET(^SC(HLOCIEN,0)),U,7)

 +5        SET ENT="LOC.`"_HLOCIEN

 +6        IF +CLSTP>0

               SET ENT=ENT_U_"CST.`"_CLSTP

 +7        IF +DIV>0

               SET ENT=ENT_U_"DIV.`"_DIV

 +8        SET ENT=ENT_U_"SYS"

 +9        IF WHAT="INFO"

               DO GETWP^XPAR(.ORPAR,ENT,"OR SD ADDITIONAL INFORMATION",,.ERR)

 +10       IF WHAT="PRE"

               DO GETLST^XPAR(.ORPAR,ENT,"OR SD DIALOG PREREQ","N",.ERR)

 +11       SET CNT=0

           SET ILST=0

FOR

               SET CNT=$ORDER(ORPAR(CNT))

               if CNT'>0

                   QUIT

               Begin DoDot:1

 +12               IF WHAT="INFO"

                       SET ILST=ILST+1

                       SET LST(ILST)=ORPAR(CNT,0)

                       QUIT

 +13               SET ILST=ILST+1

                   SET LST(ILST)=$PIECE(ORPAR(CNT),U,2)

               End DoDot:1

 +14       QUIT

 +15      ;

INFO(LST,ILST,DFN,LOC) ;

 +1        NEW CNT,ENT,ERR,ORPAR,SYSONLY

 +2        IF '$$SYSONLY("OR SD ADDITIONAL INFORMATION")

               QUIT

 +3       ;D ENVAL^XPAR(.ORPAR,"OR SD ADDITIONAL INFORMATION","",.ERR)

 +4       ;S ENT="" F  S ENT=$O(ORPAR(ENT)) Q:ENT=""!(SYSONLY=0)  S:ENT'["DIC(4.2" SYSONLY=0

 +5       ;I SYSONLY=0 Q

 +6        KILL ORPAR

 +7        DO GETWP^XPAR(.ORPAR,"SYS","OR SD ADDITIONAL INFORMATION",,.ERR)

 +8        SET CNT=0

FOR

               SET CNT=$ORDER(ORPAR(CNT))

               if CNT'>0

                   QUIT

               Begin DoDot:1

 +9                SET ILST=ILST+1

                   SET LST(ILST)="t"_ORPAR(CNT,0)

               End DoDot:1

 +10       QUIT

 +11      ;

INTERVAL(LST,ILST,DFN,LOC) ;

 +1        SET ILST=ILST+1

           SET LST(ILST)="id^Daily"

 +2        SET ILST=ILST+1

           SET LST(ILST)="iw^Weekly"

 +3        QUIT

 +4       ;

OFFSET(LST,ILST,DFN,LOC) ;

 +1        NEW OFFSET

 +2        SET OFFSET=$$GET^XPAR("SYS","OR SD CIDC STOP OFFSET",1,"E")

 +3        IF OFFSET'>0

               SET OFFSET=30

 +4        SET ILST=ILST+1

           SET LST(ILST)="i"_OFFSET_U_OFFSET

 +5        QUIT

PREREQ(LST,ILST,DFN,LOC) ;

 +1        NEW ORPAR,X

 +2        IF '$$SYSONLY("OR SD DIALOG PREREQ")

               QUIT

 +3        DO GETLST^XPAR(.ORPAR,"SYS","OR SD DIALOG PREREQ","N",.ERR)

 +4       ;D PREREQP^ORCDSD(.PREREQS)

 +5        SET X=0

FOR

               SET X=$ORDER(ORPAR(X))

               if X'>0

                   QUIT

               IF $GET(ORPAR(X))'=""

                   SET ILST=ILST+1

                   SET LST(ILST)="i"_$GET(ORPAR(X))

 +6        QUIT

 +7       ;

PROVIDER(LST,ILST,DFN,LOC) ;

 +1        NEW CNT,PLST

 +2        DO NEWPERS^ORWU(.PLST,"",1,"PROVIDER",DT,0,"")

 +3        SET CNT=0

FOR

               SET CNT=$ORDER(PLST(CNT))

               if CNT'>0

                   QUIT

               SET ILST=ILST+1

               SET LST(ILST)="i"_PLST(CNT)

 +4        QUIT

 +5       ;

SHORT     ; from DLGSLCT, get short list of med quick orders

 +1        NEW I,X,TMP

 +2        SET X="CSDAM"

 +3        DO GETQLST^ORWDXQ(.TMP,X,"iQ")

 +4        SET I=0

FOR

               SET I=$ORDER(TMP(I))

               if 'I

                   QUIT

               SET ILST=ILST+1

               SET LST(ILST)=TMP(I)

 +5        QUIT

 +6       ;

RTC       ;

 +1        NEW INT,NUM,PROMPT

 +2       ;S PROMPT=$O(^ORD(101.41,"AB","OR GTX STOP DATE",0))

 +3       ;S ORDIALOG(PROMPT,1)=$$SETSTOP^ORCDSD()

 +4       ;get number of appointments and interval

 +5        SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX APPT NUM",0))

 +6        SET NUM=$GET(ORDIALOG(PROMPT,1))

 +7        SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX SCH INTERVAL",0))

 +8        SET INT=$GET(ORDIALOG(PROMPT,1))

 +9       ;check that apppointment and interval match

 +10       IF NUM>1

               IF INT=""

                   SET AUTOACK=0

                   QUIT

 +11       IF INT'=""

               IF NUM=1

                   SET AUTOACK=0

                   QUIT

 +12       QUIT

 +13      ;

SYSONLY(PARAM) ;

 +1        NEW ERR,SYSONLY

 +2        SET SYSONLY=1

 +3        DO ENVAL^XPAR(.ORPAR,PARAM,"",.ERR)

 +4        SET ENT=""

FOR

               SET ENT=$ORDER(ORPAR(ENT))

               if ENT=""!(SYSONLY=0)

                   QUIT

               if ENT'["DIC(4.2"

                   SET SYSONLY=0

 +5        QUIT SYSONLY

ORWDSD1.m