Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECSTP

SDECSTP.m

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