- 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 Jan 18, 2025@03:53:51 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 ;