SDECSTP ;ALB/BNT - SCHEDULING ENHANCEMENTS STOP CODES ;11/04/2012
;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
;
; Reference to file 40.7 supported through IA 557
; Reference to ^XPAR supported through IA 2263
; Reference to ^SC global supported through IA 10040
; Reference to ^%ZTLOAD supported by IA #10063
;
Q
;
LST ; Display the SCHEDULING STOP CODES Parameters
N LIST,NP,SCIEN,SDECTYPE,CLSTIEN,ARR,SDECQ,SDECPAGE,NP
N SDECDATA,SDECLNS,SDECSCR,SDECNOW,SDECARR,SDECPARM,ZTQUEUED,ZTREQ
S (SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC)=0
S SDECNOW=$$FMTE^XLFDT(DT)
D DEVICE I SDECQ Q
;
D HDR(.SDECPAGE,1,SDECNOW)
F SDECPARM="SDEC PRIMARY CARE STOP CODES","SDEC SPECIALTY CARE STOP CODES","SDEC MENTAL HEALTH STOP CODES" D Q:SDECQ
. N LIST,X,CLSTIEN,SDECSTP,SDECARR D GETLST^XPAR(.LIST,"PKG.SCHEDULING",SDECPARM,"B")
. I $G(LIST)=0 D ADD(SDECPARM) Q
. ; Sort the list by Stop Code number first
. S X="" F S X=$O(LIST(X)) Q:X="" D
. . S CLSTIEN=$P(LIST(X,"N"),U)
. . S SDECSTP=$P(^DIC(40.7,CLSTIEN,0),U,2)
. . S SDECARR(SDECSTP)=$P(LIST(X,"N"),U,2)
. ; Print the sorted list
. S X="" F S X=$O(SDECARR(X)) Q:X="" D Q:SDECQ
. . S NP=$$CHKP(1,1,SDECNOW) Q:SDECQ
. . D WRLN1(X_" - "_SDECARR(X),$S(SDECPARM["PRIMARY":"Primary Care",SDECPARM["SPECIALTY":"Specialty Care",1:"Mental Health"))
. ;Q:SDECQ D PAUSE Q:SDECQ
Q
;
LSTCLN ; Display all Hospital Locations with SCHEDULING Stop Codes
N CLST,HLOC,HLOCIEN,SDECSTP,SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC,SDECNOW,SDECARR,SDECCNT,SDECTOT,SDRT,SDECLN
S (SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC,SDECCNT,SDECTOT)=0
S SDECNOW=$$FMTE^XLFDT(DT)
;
; Write Wait Message
W ! D WAIT^DICD
; Get Hospital Location
D GETCLNS(.SDECARR)
;
D DEVICE I SDECQ Q
D HDR(.SDECPAGE,2,SDECNOW) Q:SDECQ
; Write the Locations
S SDECLN="" F SDRT="P","S","M" F S SDECLN=$O(SDECARR(SDRT,SDECLN)) Q:SDECLN="" D Q:SDECQ
. S NP=$$CHKP(1,2,SDECNOW) Q:SDECQ
. D WRLN2(SDECLN,SDRT,$P(SDECARR(SDRT,SDECLN),U,2)_"-"_$P(SDECARR(SDRT,SDECLN),U,3))
I 'SDECQ W !!,?5,"Total Clinics: ",SDECTOT
Q
;
GETCLNS(SDECARR) ; Get all Scheduling Hospital Location Clinics
; Input: SDECARR = Array passed by ref to return clinics
; Output: SDECARR(Report Type,Clinic Name)=Hospital Location IEN^Stop Code^Stop Code Name
;
; Report Type are (P=Primary Care, S=Specialty Care, M=Mental Health)
;
N HLOC,HLOCIEN,SDECQ,SDECSTP,SDECCNT
S SDECCNT=0 K SDECARR
; Build Location Array
S HLOC="" F S HLOC=$O(^SC("B",HLOC)) Q:HLOC="" D
. S HLOCIEN=$O(^SC("B",HLOC,0))
. I '$D(^SC(HLOCIEN,0)) Q
. S SDECSTP=$$FLTCL(HLOCIEN) Q:'+SDECSTP
. S SDECCNT=SDECCNT+1,SDECTOT=SDECCNT
. S SDECARR($P(SDECSTP,U,2),HLOC)=HLOCIEN_U_$P(SDECSTP,U,3)_U_$P(SDECSTP,U,4)
. Q
Q
;
ADD(SDECPARM) ;
N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,LIST,ERR,DIRUT,Y,SDECSTP,SDECNAME,SDECAT,SDQ
S (SDQ,ERR)=0
I $G(SDECPARM)="" D Q:SDQ
. N Y,X S DIR(0)="S^P:Primary Care;S:Specialty Care;M:Mental Health"
. S DIR("A")="CS Management Resource Report Type"
. D ^DIR I ($D(DIRUT))!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) S SDQ=1 Q
. S SDECPARM=$S(Y="P":"SDEC PRIMARY CARE STOP CODES",Y="S":"SDEC SPECIALTY CARE STOP CODES",1:"SDEC MENTAL HEALTH STOP CODES")
S SDECAT=$S(SDECPARM["PRIMARY":"Primary Care",SDECPARM["SPECIALTY":"Specialty Care",1:"Mental Health")
D GETLST^XPAR(.LIST,"PKG.SCHEDULING",SDECPARM,"B")
;
W !
N Y,X S DIR(0)="P^40.7:EMZ",DIR("A")="Select "_SDECAT_" Clinic Stop Code",DIR("S")="I '$P(^(0),U,3)" D ^DIR
Q:($D(DIRUT))!($D(DTOUT))!($D(DUOUT))!($D(DIROUT))
Q:'+Y
S SDECSTP=+Y,SDECNAME=$P(Y,U,2)
S X="" F S X=$O(LIST(X)) Q:X="" I $P(LIST(X,"N"),U)=SDECSTP D G EXIT
. W !!,SDECNAME_" is an existing "_SDECAT_" Clinic Stop Code."
. N DIR S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Remove "_SDECAT_" Clinic Stop Code "_SDECNAME
. D ^DIR I $D(DIRUT)!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) G EXIT
. I +Y D
. . N ERR D EN^XPAR("PKG.SCHEDULING",SDECPARM,"`"_SDECSTP,"@",.ERR)
. . I 'ERR W !!,SDECNAME_" removed from "_SDECAT_" Clinic Stop Code parameter list."
N DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Add "_SDECNAME_" as a new "_SDECAT_" Clinic Stop Code"
D ^DIR I $D(DIRUT)!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) G EXIT
I +Y D EN^XPAR("PKG.SCHEDULING",SDECPARM,"`"_SDECSTP,1,.ERR)
I 'ERR,Y W !!,SDECNAME_" added to "_SDECAT_" Clinic Stop Code parameter list." Q
W !!,"There was an error editing this Stop Code"
W !,"Error Code-Description: "_ERR
;
Q
;
HDR(SDECPAGE,LST,SDECNOW) ; Write the header
; Define SDECDATA - Tells whether data has been displayed for a screen
S SDECDATA=0
S SDECPAGE=$G(SDECPAGE)+1
W @IOF
;
W !,"Print Date: "_$G(SDECNOW),$$RJ("Page: "_SDECPAGE,40)
;
D ULINE("-") Q:$G(SDECQ)
I SDECDESC Q
I LST=1 D HDLN1
I LST=2 D HDLN2
D ULINE("-")
Q
;
HDLN1 ;
W !,?1,"Category",?20,"Clinic Stop Code"
Q
;
HDLN2 ;
W !,"Clinic Service/Location",?33,"Category",?43,"Clinic Stop Code"
Q
;
CHKP(SDECLNS,LST,SDECNOW) ; Check for End of Page
; Input variables -> SDECLNS -> Number of lines from bottom
;
; Output variable -> SDECDATA -> 0 -> New screen, no data displayed yet
; 1 -> Data displayed on current screen
S SDECLNS=SDECLNS+1
I $G(SDECSCR) S SDECLNS=SDECLNS+2
I $G(SDECSCR),'$G(SDECDATA) S SDECDATA=1 Q 0
S SDECDATA=1
I $Y>(IOSL-SDECLNS) D:$G(SDECSCR) PAUSE Q:$G(SDECQ) 0 D HDR(.SDECPAGE,LST,SDECNOW) Q 1
Q 0
;
WRDESC(LINE) ; Write the description line
W !,LINE
Q
;
WRLN1(CLSTP,CLSCAT) ; Write the SDEC Stop Codes
W !,?1,CLSCAT,?20,CLSTP
Q
;
WRLN2(HLOC,CAT,CLSTP) ; Write the Clinic Location, Category and Stop Code
W !,HLOC,?33,CAT,?43,CLSTP
Q
;
ULINE(X) ;Print one line of characters
N I
W ! F I=1:1:80 W $G(X,"-")
Q
;
;right justified, blank padded
;adds spaces on left or truncates to make return string SDECLEN characters long
;SDECST- original string
;SDECLEN - desired length
RJ(SDECST,SDECLEN) ;
N SDECL
S SDECL=SDECLEN-$L(SDECST)
I SDECL>0 Q $J("",$S(SDECL<0:0,1:SDECL))_SDECST
Q $E(SDECST,1,SDECLEN)
;
;Screen Pause 1
;
; Return variable - SDECQ = 0 Continue
; 2 Quit
PAUSE N X
U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
R X:$G(DTIME) S:'$T X="^" S:X["^" SDECQ=2
U IO
Q
;
;Screen Pause 2
;
; Return variable - SDECQ = 0 Continue
; 2 Quit
PAUSE2 N X
U IO(0) W !!,"Press RETURN to continue:"
R X:$G(DTIME) S:'$T X="^" S:X["^" SDECQ=2
U IO
Q
;
;Prompt For the Device
;
; Returns Device variables and FBSCR
;
DEVICE ;
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
S %ZIS="QM"
D ^%ZIS
I POP S SDECQ=1
;
;Check for exit
I $G(SDECQ) G EXIT
;
S SDECSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
I $D(IO("Q")) D S SDECQ=1
. S ZTRTN="LST^SDECSTP"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="SDEC Hospital Locations"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
U IO
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
FLTCL(LOC) ; Filter the Clinic Hospital Locations
; Input = Hospital Location file #44 IEN
; Returns 0 = Invalid SQWM Clinic Stop
; 1^STOP CODE NAME^Clinic Name
I LOC="" Q 0
N OK,IDATE,RDATE S OK=1
; If LOC does not exist, check location name
I '$D(^SC(LOC,0)) S LOC=$O(^SC("B",LOC,0)) I '$D(^SC(LOC,0)) Q 0
; Has clinic been Inactivated?
S IDATE=$P($G(^SC(LOC,"I")),U),RDATE=$P($G(^SC(LOC,"I")),U,2)
; Is clinic Inactive?
I IDATE S OK=0 D
. ; Has clinic been Reactivated?
. I RDATE>IDATE S OK=1
. ; Is Reactivate date in the future?
. I RDATE>DT S OK=0
Q:'OK 0
Q $$FLTCLSTP($P($G(^SC(LOC,0)),U,7))_U_$P(^SC(LOC,0),U)
;
FLTCLSTP(CLST) ; Filter the CLINIC STOP codes
; Filter SCHEDULING STOP CODES Parameters
;
; Returns 0 = Invalid Clinic Stop
; 1^Parameter Category^STOP CODE^STOP CODE NAME = Valid Clinic Stop
; Parameter Categories are (P=Primary Care, S=Specialty Care, M=Mental Health)
N OK,X,LIST
S OK=0
Q:CLST="" OK
D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
I +$G(LIST) S X="" F S X=$O(LIST(X)) Q:('X)!(+OK) I +LIST(X,"N")=CLST S OK=1_"^P^"_$P(^DIC(40.7,CLST,0),U,2)_U_$P(LIST(X,"N"),U,2)
Q:OK OK
N LIST,X
D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
I +$G(LIST) S X="" F S X=$O(LIST(X)) Q:('X)!(+OK) I +LIST(X,"N")=CLST S OK=1_"^S^"_$P(^DIC(40.7,CLST,0),U,2)_U_$P(LIST(X,"N"),U,2)
Q:OK OK
N LIST,X
D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
I +$G(LIST) S X="" F S X=$O(LIST(X)) Q:('X)!(+OK) I +LIST(X,"N")=CLST S OK=1_"^M^"_$P(^DIC(40.7,CLST,0),U,2)_U_$P(LIST(X,"N"),U,2)
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECSTP 8876 printed Apr 09, 2024@21:52:20 Page 2
SDECSTP ;ALB/BNT - SCHEDULING ENHANCEMENTS STOP CODES ;11/04/2012
+1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
+2 ;
+3 ; Reference to file 40.7 supported through IA 557
+4 ; Reference to ^XPAR supported through IA 2263
+5 ; Reference to ^SC global supported through IA 10040
+6 ; Reference to ^%ZTLOAD supported by IA #10063
+7 ;
+8 QUIT
+9 ;
LST ; Display the SCHEDULING STOP CODES Parameters
+1 NEW LIST,NP,SCIEN,SDECTYPE,CLSTIEN,ARR,SDECQ,SDECPAGE,NP
+2 NEW SDECDATA,SDECLNS,SDECSCR,SDECNOW,SDECARR,SDECPARM,ZTQUEUED,ZTREQ
+3 SET (SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC)=0
+4 SET SDECNOW=$$FMTE^XLFDT(DT)
+5 DO DEVICE
IF SDECQ
QUIT
+6 ;
+7 DO HDR(.SDECPAGE,1,SDECNOW)
+8 FOR SDECPARM="SDEC PRIMARY CARE STOP CODES","SDEC SPECIALTY CARE STOP CODES","SDEC MENTAL HEALTH STOP CODES"
Begin DoDot:1
+9 NEW LIST,X,CLSTIEN,SDECSTP,SDECARR
DO GETLST^XPAR(.LIST,"PKG.SCHEDULING",SDECPARM,"B")
+10 IF $GET(LIST)=0
DO ADD(SDECPARM)
QUIT
+11 ; Sort the list by Stop Code number first
+12 SET X=""
FOR
SET X=$ORDER(LIST(X))
if X=""
QUIT
Begin DoDot:2
+13 SET CLSTIEN=$PIECE(LIST(X,"N"),U)
+14 SET SDECSTP=$PIECE(^DIC(40.7,CLSTIEN,0),U,2)
+15 SET SDECARR(SDECSTP)=$PIECE(LIST(X,"N"),U,2)
End DoDot:2
+16 ; Print the sorted list
+17 SET X=""
FOR
SET X=$ORDER(SDECARR(X))
if X=""
QUIT
Begin DoDot:2
+18 SET NP=$$CHKP(1,1,SDECNOW)
if SDECQ
QUIT
+19 DO WRLN1(X_" - "_SDECARR(X),$SELECT(SDECPARM["PRIMARY":"Primary Care",SDECPARM["SPECIALTY":"Specialty Care",1:"Mental Health"))
End DoDot:2
if SDECQ
QUIT
+20 ;Q:SDECQ D PAUSE Q:SDECQ
End DoDot:1
if SDECQ
QUIT
+21 QUIT
+22 ;
LSTCLN ; Display all Hospital Locations with SCHEDULING Stop Codes
+1 NEW CLST,HLOC,HLOCIEN,SDECSTP,SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC,SDECNOW,SDECARR,SDECCNT,SDECTOT,SDRT,SDECLN
+2 SET (SDECQ,SDECPAGE,NP,SDECDATA,SDECLNS,SDECSCR,SDECDESC,SDECCNT,SDECTOT)=0
+3 SET SDECNOW=$$FMTE^XLFDT(DT)
+4 ;
+5 ; Write Wait Message
+6 WRITE !
DO WAIT^DICD
+7 ; Get Hospital Location
+8 DO GETCLNS(.SDECARR)
+9 ;
+10 DO DEVICE
IF SDECQ
QUIT
+11 DO HDR(.SDECPAGE,2,SDECNOW)
if SDECQ
QUIT
+12 ; Write the Locations
+13 SET SDECLN=""
FOR SDRT="P","S","M"
FOR
SET SDECLN=$ORDER(SDECARR(SDRT,SDECLN))
if SDECLN=""
QUIT
Begin DoDot:1
+14 SET NP=$$CHKP(1,2,SDECNOW)
if SDECQ
QUIT
+15 DO WRLN2(SDECLN,SDRT,$PIECE(SDECARR(SDRT,SDECLN),U,2)_"-"_$PIECE(SDECARR(SDRT,SDECLN),U,3))
End DoDot:1
if SDECQ
QUIT
+16 IF 'SDECQ
WRITE !!,?5,"Total Clinics: ",SDECTOT
+17 QUIT
+18 ;
GETCLNS(SDECARR) ; Get all Scheduling Hospital Location Clinics
+1 ; Input: SDECARR = Array passed by ref to return clinics
+2 ; Output: SDECARR(Report Type,Clinic Name)=Hospital Location IEN^Stop Code^Stop Code Name
+3 ;
+4 ; Report Type are (P=Primary Care, S=Specialty Care, M=Mental Health)
+5 ;
+6 NEW HLOC,HLOCIEN,SDECQ,SDECSTP,SDECCNT
+7 SET SDECCNT=0
KILL SDECARR
+8 ; Build Location Array
+9 SET HLOC=""
FOR
SET HLOC=$ORDER(^SC("B",HLOC))
if HLOC=""
QUIT
Begin DoDot:1
+10 SET HLOCIEN=$ORDER(^SC("B",HLOC,0))
+11 IF '$DATA(^SC(HLOCIEN,0))
QUIT
+12 SET SDECSTP=$$FLTCL(HLOCIEN)
if '+SDECSTP
QUIT
+13 SET SDECCNT=SDECCNT+1
SET SDECTOT=SDECCNT
+14 SET SDECARR($PIECE(SDECSTP,U,2),HLOC)=HLOCIEN_U_$PIECE(SDECSTP,U,3)_U_$PIECE(SDECSTP,U,4)
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
ADD(SDECPARM) ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,LIST,ERR,DIRUT,Y,SDECSTP,SDECNAME,SDECAT,SDQ
+2 SET (SDQ,ERR)=0
+3 IF $GET(SDECPARM)=""
Begin DoDot:1
+4 NEW Y,X
SET DIR(0)="S^P:Primary Care;S:Specialty Care;M:Mental Health"
+5 SET DIR("A")="CS Management Resource Report Type"
+6 DO ^DIR
IF ($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
SET SDQ=1
QUIT
+7 SET SDECPARM=$SELECT(Y="P":"SDEC PRIMARY CARE STOP CODES",Y="S":"SDEC SPECIALTY CARE STOP CODES",1:"SDEC MENTAL HEALTH STOP CODES")
End DoDot:1
if SDQ
QUIT
+8 SET SDECAT=$SELECT(SDECPARM["PRIMARY":"Primary Care",SDECPARM["SPECIALTY":"Specialty Care",1:"Mental Health")
+9 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING",SDECPARM,"B")
+10 ;
+11 WRITE !
+12 NEW Y,X
SET DIR(0)="P^40.7:EMZ"
SET DIR("A")="Select "_SDECAT_" Clinic Stop Code"
SET DIR("S")="I '$P(^(0),U,3)"
DO ^DIR
+13 if ($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+14 if '+Y
QUIT
+15 SET SDECSTP=+Y
SET SDECNAME=$PIECE(Y,U,2)
+16 SET X=""
FOR
SET X=$ORDER(LIST(X))
if X=""
QUIT
IF $PIECE(LIST(X,"N"),U)=SDECSTP
Begin DoDot:1
+17 WRITE !!,SDECNAME_" is an existing "_SDECAT_" Clinic Stop Code."
+18 NEW DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+19 SET DIR("A")="Remove "_SDECAT_" Clinic Stop Code "_SDECNAME
+20 DO ^DIR
IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
GOTO EXIT
+21 IF +Y
Begin DoDot:2
+22 NEW ERR
DO EN^XPAR("PKG.SCHEDULING",SDECPARM,"`"_SDECSTP,"@",.ERR)
+23 IF 'ERR
WRITE !!,SDECNAME_" removed from "_SDECAT_" Clinic Stop Code parameter list."
End DoDot:2
End DoDot:1
GOTO EXIT
+24 NEW DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Add "_SDECNAME_" as a new "_SDECAT_" Clinic Stop Code"
+25 DO ^DIR
IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
GOTO EXIT
+26 IF +Y
DO EN^XPAR("PKG.SCHEDULING",SDECPARM,"`"_SDECSTP,1,.ERR)
+27 IF 'ERR
IF Y
WRITE !!,SDECNAME_" added to "_SDECAT_" Clinic Stop Code parameter list."
QUIT
+28 WRITE !!,"There was an error editing this Stop Code"
+29 WRITE !,"Error Code-Description: "_ERR
+30 ;
+31 QUIT
+32 ;
HDR(SDECPAGE,LST,SDECNOW) ; Write the header
+1 ; Define SDECDATA - Tells whether data has been displayed for a screen
+2 SET SDECDATA=0
+3 SET SDECPAGE=$GET(SDECPAGE)+1
+4 WRITE @IOF
+5 ;
+6 WRITE !,"Print Date: "_$GET(SDECNOW),$$RJ("Page: "_SDECPAGE,40)
+7 ;
+8 DO ULINE("-")
if $GET(SDECQ)
QUIT
+9 IF SDECDESC
QUIT
+10 IF LST=1
DO HDLN1
+11 IF LST=2
DO HDLN2
+12 DO ULINE("-")
+13 QUIT
+14 ;
HDLN1 ;
+1 WRITE !,?1,"Category",?20,"Clinic Stop Code"
+2 QUIT
+3 ;
HDLN2 ;
+1 WRITE !,"Clinic Service/Location",?33,"Category",?43,"Clinic Stop Code"
+2 QUIT
+3 ;
CHKP(SDECLNS,LST,SDECNOW) ; Check for End of Page
+1 ; Input variables -> SDECLNS -> Number of lines from bottom
+2 ;
+3 ; Output variable -> SDECDATA -> 0 -> New screen, no data displayed yet
+4 ; 1 -> Data displayed on current screen
+5 SET SDECLNS=SDECLNS+1
+6 IF $GET(SDECSCR)
SET SDECLNS=SDECLNS+2
+7 IF $GET(SDECSCR)
IF '$GET(SDECDATA)
SET SDECDATA=1
QUIT 0
+8 SET SDECDATA=1
+9 IF $Y>(IOSL-SDECLNS)
if $GET(SDECSCR)
DO PAUSE
if $GET(SDECQ)
QUIT 0
DO HDR(.SDECPAGE,LST,SDECNOW)
QUIT 1
+10 QUIT 0
+11 ;
WRDESC(LINE) ; Write the description line
+1 WRITE !,LINE
+2 QUIT
+3 ;
WRLN1(CLSTP,CLSCAT) ; Write the SDEC Stop Codes
+1 WRITE !,?1,CLSCAT,?20,CLSTP
+2 QUIT
+3 ;
WRLN2(HLOC,CAT,CLSTP) ; Write the Clinic Location, Category and Stop Code
+1 WRITE !,HLOC,?33,CAT,?43,CLSTP
+2 QUIT
+3 ;
ULINE(X) ;Print one line of characters
+1 NEW I
+2 WRITE !
FOR I=1:1:80
WRITE $GET(X,"-")
+3 QUIT
+4 ;
+5 ;right justified, blank padded
+6 ;adds spaces on left or truncates to make return string SDECLEN characters long
+7 ;SDECST- original string
+8 ;SDECLEN - desired length
RJ(SDECST,SDECLEN) ;
+1 NEW SDECL
+2 SET SDECL=SDECLEN-$LENGTH(SDECST)
+3 IF SDECL>0
QUIT $JUSTIFY("",$SELECT(SDECL<0:0,1:SDECL))_SDECST
+4 QUIT $EXTRACT(SDECST,1,SDECLEN)
+5 ;
+6 ;Screen Pause 1
+7 ;
+8 ; Return variable - SDECQ = 0 Continue
+9 ; 2 Quit
PAUSE NEW X
+1 USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit:"
+2 READ X:$GET(DTIME)
if '$TEST
SET X="^"
if X["^"
SET SDECQ=2
+3 USE IO
+4 QUIT
+5 ;
+6 ;Screen Pause 2
+7 ;
+8 ; Return variable - SDECQ = 0 Continue
+9 ; 2 Quit
PAUSE2 NEW X
+1 USE IO(0)
WRITE !!,"Press RETURN to continue:"
+2 READ X:$GET(DTIME)
if '$TEST
SET X="^"
if X["^"
SET SDECQ=2
+3 USE IO
+4 QUIT
+5 ;
+6 ;Prompt For the Device
+7 ;
+8 ; Returns Device variables and FBSCR
+9 ;
DEVICE ;
+1 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
+2 SET %ZIS="QM"
+3 DO ^%ZIS
+4 IF POP
SET SDECQ=1
+5 ;
+6 ;Check for exit
+7 IF $GET(SDECQ)
GOTO EXIT
+8 ;
+9 SET SDECSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 SET ZTRTN="LST^SDECSTP"
+12 SET ZTIO=ION
+13 SET ZTSAVE("*")=""
+14 SET ZTDESC="SDEC Hospital Locations"
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
End DoDot:1
SET SDECQ=1
+18 USE IO
+19 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
FLTCL(LOC) ; Filter the Clinic Hospital Locations
+1 ; Input = Hospital Location file #44 IEN
+2 ; Returns 0 = Invalid SQWM Clinic Stop
+3 ; 1^STOP CODE NAME^Clinic Name
+4 IF LOC=""
QUIT 0
+5 NEW OK,IDATE,RDATE
SET OK=1
+6 ; If LOC does not exist, check location name
+7 IF '$DATA(^SC(LOC,0))
SET LOC=$ORDER(^SC("B",LOC,0))
IF '$DATA(^SC(LOC,0))
QUIT 0
+8 ; Has clinic been Inactivated?
+9 SET IDATE=$PIECE($GET(^SC(LOC,"I")),U)
SET RDATE=$PIECE($GET(^SC(LOC,"I")),U,2)
+10 ; Is clinic Inactive?
+11 IF IDATE
SET OK=0
Begin DoDot:1
+12 ; Has clinic been Reactivated?
+13 IF RDATE>IDATE
SET OK=1
+14 ; Is Reactivate date in the future?
+15 IF RDATE>DT
SET OK=0
End DoDot:1
+16 if 'OK
QUIT 0
+17 QUIT $$FLTCLSTP($PIECE($GET(^SC(LOC,0)),U,7))_U_$PIECE(^SC(LOC,0),U)
+18 ;
FLTCLSTP(CLST) ; Filter the CLINIC STOP codes
+1 ; Filter SCHEDULING STOP CODES Parameters
+2 ;
+3 ; Returns 0 = Invalid Clinic Stop
+4 ; 1^Parameter Category^STOP CODE^STOP CODE NAME = Valid Clinic Stop
+5 ; Parameter Categories are (P=Primary Care, S=Specialty Care, M=Mental Health)
+6 NEW OK,X,LIST
+7 SET OK=0
+8 if CLST=""
QUIT OK
+9 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
+10 IF +$GET(LIST)
SET X=""
FOR
SET X=$ORDER(LIST(X))
if ('X)!(+OK)
QUIT
IF +LIST(X,"N")=CLST
SET OK=1_"^P^"_$PIECE(^DIC(40.7,CLST,0),U,2)_U_$PIECE(LIST(X,"N"),U,2)
+11 if OK
QUIT OK
+12 NEW LIST,X
+13 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
+14 IF +$GET(LIST)
SET X=""
FOR
SET X=$ORDER(LIST(X))
if ('X)!(+OK)
QUIT
IF +LIST(X,"N")=CLST
SET OK=1_"^S^"_$PIECE(^DIC(40.7,CLST,0),U,2)_U_$PIECE(LIST(X,"N"),U,2)
+15 if OK
QUIT OK
+16 NEW LIST,X
+17 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
+18 IF +$GET(LIST)
SET X=""
FOR
SET X=$ORDER(LIST(X))
if ('X)!(+OK)
QUIT
IF +LIST(X,"N")=CLST
SET OK=1_"^M^"_$PIECE(^DIC(40.7,CLST,0),U,2)_U_$PIECE(LIST(X,"N"),U,2)
+19 QUIT OK
+20 ;
