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

BSDCP.m

Go to the documentation of this file. 
  1. BSDCP ; IHS/ANMC/LJF - CLINIC PROFILE ;  
  1.  ;;5.3;PIMS;**1007,1010**;FEB 27, 2007
  1.  ; 
  1.  ;11/1/02 WAR - changed 2 lines in DATA, external doc LJF29,P36
  1.  ;cmi/anch/maw 11/22/2006 PATCH 1007 added code in INIT for item 1007.30
  1.  ;cmi/anch/maw 2/15/2007 PATCH 1007 modified code in INIT for item 1007.29
  1.  ;cmi/anch/maw 05/15/2009 PATCH 1010 modified code in init for item 1010.42
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTD,VAUTC,POP,BSDQ
  1.  D CLINIC^BSDU(1,"") Q:$D(BSDQ)   ;IHS/ITSC/LJF 4/21/2004
  1.  ;D CLINIC^BSDU(1,1) Q:$D(BSDQ)     ;IHS/ITSC/LJF 4/21/2004
  1.  D CHKPC(.VAUTC)  ;cmi/anch/maw 2/15/2007 check to see if an inactive principal clinic and then get all grouped clinics PATCH 1007 item 1007.29
  1.  S Y=$$BROWSE^BDGF Q:"PB"'[Y  I Y="B" D EN Q
  1.  D ZIS^BDGF("PQ","START^BSDCP","CLINIC PROFILE","VAUTD*;VAUTC*")
  1.  Q
  1.  ;
  1. CHKPC(PC) ;-- check to see if there are principal clinics and if so expand them
  1.  N CHK
  1.  S CHK=0 F  S CHK=$O(PC(CHK)) Q:CHK=""  D
  1.  . N PCI
  1.  . S PCI=$G(PC(CHK))
  1.  . I $D(^SC("AIHSPC",PCI)) D EXPNDPC^BSDU(1,.VAUTC)
  1.  Q
  1.  ;
  1. START ;EP; entry point when printing to paper
  1.  D INIT,PRINT Q
  1.  ;
  1. EN ; -- main entry point for BSDRM CLINIC PROFILE
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM CLINIC PROFILE")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K ^TMP("BSDCP",$J) S VALMCNT=0
  1.  ;NEW ARRAY S ARRAY=$S(VAUTC:"^SC(""B"",",1:"VAUTC")  ;cmi/maw 5/15/2009 orig line PATCH 1010 RQMT 42
  1.  NEW ARRAY S ARRAY=$S(VAUTC:"^SC(""B"")",1:"VAUTC")  ;cmi/maw 5/15/2009 PATCH 1010 RQMT 42
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW NAME,CLN,COL1,COL2,I,LINE
  1.  S NAME=0 F  S NAME=$O(@ARRAY@(NAME)) Q:NAME=""  D
  1.  . S CLN=$S(ARRAY="VAUTC":VAUTC(NAME),1:$O(^SC("B",NAME,0)))
  1.  . Q:'CLN  Q:$$GET1^DIQ(44,CLN,2)'="CLINIC"
  1.  . ;
  1.  . ;I '$$ACTV^BSDU(CLN,DT) D  Q               ;inactive clinic cmi/anch/maw 2/15/2007 orig line
  1.  . I '$$ACTV^BSDU(CLN,DT) D               ;inactive clinic cmi/anch/maw 2/15/2007 mod line PATCH 1107 item 1007.29
  1.  .. S LINE=$$PAD($$SP(15)_NAME,40)
  1.  .. S LINE=LINE_"*** Inactivated on "_$$INACTVDT^BSDU(CLN)
  1.  .. D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  . ;
  1.  . S COL1=15,COL2=18                         ;used to line up columns
  1.  . ;I $D(^SC("AIHSPC",CLN)) D PRINC(CLN) Q    ;principal clinic cmi/anch/maw 2/15/2006 orig line
  1.  . I $D(^SC("AIHSPC",CLN)) D PRINC(CLN)    ;principal clinic cmi/anch/maw 2/15/2006 mod line PATCH 1007 item 1007.29
  1.  . ;
  1.  . F I=1:2:24 D DISPLAY(I)                   ;first set of data items
  1.  . ;
  1.  . D SET("",.VALMCNT),SET("Appointment List Statement: "_$$GET1^DIQ(9009017.2,CLN,.02),.VALMCNT)
  1.  . D SET("",.VALMCNT),MULT("Special Instructions: ",44.03,.01,CLN)
  1.  . ;
  1.  . D SET("",.VALMCNT),SET("Clinic's Letters -",.VALMCNT)
  1.  . F I=25:2:28 D DISPLAY(I)
  1.  . ;
  1.  . D SET("",.VALMCNT),SET("Documents Printed with Routing Slips-",.VALMCNT)
  1.  . F I=29:2:32 D DISPLAY(I)
  1.  . ;
  1.  . S X=$$GET1^DIQ(9009017.2,CLN,.09)    ;create vist at checkin?
  1.  . S X="*** TURNED "_$S(X="YES":"ON",1:"OFF")_" ***"
  1.  . D SET("",.VALMCNT),SET("PCC Visit Link: "_X,.VALMCNT)
  1.  . I X["ON" F I=33:2:38 D DISPLAY(I)
  1.  . ;
  1.  . D SET("",.VALMCNT),PROV(CLN)     ;clinic's providers
  1.  . ;
  1.  . D SET("",.VALMCNT),MULT("Clinic Owners: ",9009017.22,".01",CLN)
  1.  . ;
  1.  . ;cmi/anch/maw 11/22/06 added following lines for item 1007.30 patch 1007
  1.  . D SET("",.VALMCNT),MULT("Overbook Users: ",9009017.21,".01",CLN)
  1.  . ;cmi/anch/maw 11/22/06 end of added lines item 1007.30 patch 1007
  1.  . D SET("",.VALMCNT)
  1.  . S X=$$GET1^DIQ(44,CLN,2500),X=$S(X="YES":X_" - Access Restricted to:",1:"NO")
  1.  . D SET("Prohibit Access to Make Appts: "_X,.VALMCNT)
  1.  . I X'="NO" D USERS(CLN)           ;list users with access
  1.  . ;
  1.  . D SET("",.VALMCNT),SET("",.VALMCNT)
  1.  Q
  1.  ;
  1. DISPLAY(I) ; for value of I, find captions & data & put into display array
  1.  NEW CAP1,CAP2,DATA1,DATA2,LINE
  1.  S CAP1=$P($T(DATA+I),";;",2),DATA1=$P($T(DATA+I),";;",3)
  1.  S CAP2=$P($T(DATA+I+1),";;",2),DATA2=$P($T(DATA+I+1),";;",3)
  1.  ;
  1.  X DATA1 S LINE=$$PAD($$SP(COL1-$L(CAP1))_CAP1_X,40)
  1.  X DATA2 S LINE=LINE_$$SP(COL2-$L(CAP2))_CAP2_X
  1.  D SET(LINE,.VALMCNT)
  1.  Q
  1.  ;
  1. MULT(CAPTION,FILE,FIELD,IEN) ; find multiple data and put into display array
  1.  NEW BSDX,LINE,X
  1.  D ENPM^XBDIQ1(FILE,IEN_",0",FIELD,"BSDX(")
  1.  S LINE=CAPTION
  1.  I '$D(BSDX) D SET(LINE_"None",.VALMCNT) Q
  1.  ;
  1.  S X=0 F  S X=$O(BSDX(X)) Q:'X  D
  1.  . S LINE=LINE_BSDX(X,FIELD) D SET(LINE,.VALMCNT)
  1.  . S LINE=$$SP($L(CAPTION))    ;reset beginning of line
  1.  Q
  1.  ;
  1. PRINC(CLN) ; -- display data for principal clinics
  1.  D SET($$SP(20)_"**** PRINCIPAL CLINIC ****",.VALMCNT)
  1.  F I=1:2:4 D DISPLAY(I)
  1.  ;
  1.  D SET("",.VALMCNT),SET("Documents Printed with Routing Slips-",.VALMCNT)
  1.  F I=29:2:32 D DISPLAY(I)
  1.  ;
  1.  D SET("",.VALMCNT),MULT("Clinic Owners: ",9009017.22,".01",CLN)
  1.  ;
  1.  D SET("",.VALMCNT)
  1.  S X=$$GET1^DIQ(44,CLN,2500),X=$S(X="YES":X_" - Access Restricted to:",1:"NO")
  1.  D SET("Prohibit Access to Make Appts: "_X,.VALMCNT)
  1.  I X'="NO" D USERS(CLN)           ;list users with access
  1.  ;
  1.  D SET("",.VALMCNT)
  1.  D SET("Clinics Grouped under this Principal Clinic:",.VALMCNT)
  1.  D CLINICS(CLN)
  1.  ;
  1.  D SET("",.VALMCNT),SET("",.VALMCNT)
  1.  Q
  1.  ;
  1. CLINICS(PRINC) ; list clinics under this principal clinic
  1.  NEW CLN,NAME,BSDY,X
  1.  ;
  1.  ; find clinics and put in alphabetical order
  1.  S CLN=0 F  S CLN=$O(^SC("AIHSPC",PRINC,CLN)) Q:'CLN  D
  1.  . S NAME=$$GET1^DIQ(44,CLN,.01)
  1.  . S BSDY(NAME)=$$PAD(NAME,35)_$S('$$ACTV^BSDU(CLN,DT):"Inactivated on "_$$INACTVDT^BSDU(CLN),1:"")
  1.  ;
  1.  ; put sorted list into display array
  1.  S X=0 F  S X=$O(BSDY(X)) Q:X=""  D SET(BSDY(X),.VALMCNT)
  1.  Q
  1.  ;
  1. PROV(IEN) ; display clinic's providers
  1.  NEW BSDX,LINE,X,Y
  1.  D ENPM^XBDIQ1(44.1,IEN_",0",".01;.02","BSDX(")
  1.  S LINE="Clinic's Provider(s): "
  1.  I '$D(BSDX) D SET(LINE_"None Defined",.VALMCNT) Q
  1.  ;
  1.  S X=0 F  S X=$O(BSDX(X)) Q:'X  D
  1.  . S LINE=LINE_BSDX(X,.01)_$S(BSDX(X,.02)="YES":" (Default)",1:"")
  1.  . D SET(LINE,.VALMCNT)
  1.  . S LINE=$$SP(22)             ;reset beginning of line
  1.  Q
  1.  ;
  1. USERS(IEN) ; list users with access to clinic
  1.  NEW BSDX,X,BSDY,Y,NAME,USER
  1.  D ENPM^XBDIQ1(44.04,IEN_",0",".01","BSDX(","1I") I '$O(BSDX(0)) Q
  1.  ;
  1.  ; put users found in alphabetical order
  1.  S X=0 F  S X=$O(BSDX(X)) Q:'X  D
  1.  . S NAME=BSDX(X,.01),USER=BSDX(X,.01,"I")
  1.  . S BSDY(NAME)=$$PAD($E(NAME,1,28),30)             ;user name
  1.  . S BSDY(NAME)=$$PAD(BSDY(NAME)_$$GET1^DIQ(200,USER,29),50)  ;service
  1.  . S Y=$$GET1^DIQ(200,USER,9.2) I Y>DT S Y=""       ;termination date
  1.  . S BSDY(NAME)=BSDY(NAME)_$S(Y="":"",1:"Inactivated on "_Y)
  1.  ;
  1.  ; put sorted list into display array
  1.  S X=0 F  S X=$O(BSDY(X)) Q:X=""  D SET(BSDY(X),.VALMCNT)
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; set display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDCP",$J,NUM,0)=LINE
  1.  Q
  1.  ;
  1. PRINT ; print to paper
  1.  NEW X,VALMHDR,BSDPG
  1.  U IO D HDG
  1.  S X=0 F  S X=$O(^TMP("BSDCP",$J,X)) Q:'X  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDCP",$J,X,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1.  ;
  1. HDG ; -- heading
  1.  W @IOF S BSDPG=$G(BSDPG)+1
  1.  W !?20,"CLINIC PROFILE",?55,"Printed ",$$FMTE^XLFDT(DT)
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1.  ;
  1. DATA ;;
  1.  ;;Clinic: ;;S X=NAME
  1.  ;;Abbrv: ;;S X=$$GET1^DIQ(44,CLN,1)
  1.  ;;Facility: ;;S X=$$GET1^DIQ(44,CLN,3)
  1.  ;;Service: ;;S X=$$GET1^DIQ(9009017.2,CLN,.11)
  1.  ;;Location: ;;S X=$$GET1^DIQ(44,CLN,10)
  1.  ;;Clinic Code: ;;S X=$$CLNCODE^BSDU(CLN)
  1.  ;;Telephone: ;;S X=$$GET1^DIQ(44,CLN,99)
  1.  ;;Principal Clinic: ;;S X=$$PRIN^BSDU(CLN)
  1.  ;;Non-Count: ;;S X=$$NONCOUNT^BSDU(CLN),X=$S(X="":"NO",1:"YES")
  1.  ;;File Room List: ;;S X=$$NONCOUNT^BSDU(CLN),X=$S($P(X,",",2)["NOT":"NO",1:"YES")
  1.  ;;Clinic Meets: ;;S X=$$DOW^BSDU(CLN)
  1.  ;;Sched Holidays: ;;S X=$$GET1^DIQ(44,CLN,1918.5)
  1.  ;;Appt. Display: ;;S X=$$GET1^DIQ(44,CLN,1914),X="Begins at "_$S(X="":"8 AM",X<13:X_" AM",1:(X-12)_" PM")
  1.  ;;Appt. Length: ;;S X=$$GET1^DIQ(44,CLN,1912),X=$S(X="":"",1:X_" min.")
  1.  ;;Increments: ;;S X=$$GET1^DIQ(44,CLN,1917)
  1.  ;;Variable Length: ;;S X=$$GET1^DIQ(44,CLN,1913),X=$S(X="":"NO",1:X)
  1.  ;;Overbooks/Day: ;;S X=$$GET1^DIQ(44,CLN,1918)
  1.  ;;Future Booking: ;;S X=$$GET1^DIQ(44,CLN,2002)_" days max."
  1.  ;;Auto-Rebook: ;;S X=$$GET1^DIQ(44,CLN,2003),X="Start at "_$S(X="":"earliest time",X<12:X_" AM",1:(X-12)_" PM")
  1.  ;;Max. Auto-Rebook: ;;S X=$$GET1^DIQ(44,CLN,2005)_" days"
  1.  ;;No-Shows: ;;S X=$$GET1^DIQ(44,CLN,2001)_" allowed"
  1.  ;;Wait Period: ;;S X=$$GET1^DIQ(9009017.2,CLN,.03)
  1.  ;;;;S X=""
  1.  ;;Pull Prev X-rays: ;;S X=$$GET1^DIQ(44,CLN,2000) S:X="" X="NO"
  1.  ;;Pre-Appt: ;;S X=$$GET1^DIQ(44,CLN,2509)
  1.  ;;Clinic Cancel: ;;S X=$$GET1^DIQ(44,CLN,2510)
  1.  ;;Appt. Cancel: ;;S X=$$GET1^DIQ(44,CLN,2511)
  1.  ;;No-show: ;;S X=$$GET1^DIQ(44,CLN,2508)
  1.  ;;Health Summary: ;;S X=$$HSPRINT^BSDU(CLN)
  1.  ;;AIU Form: ;;S X=$$GET1^DIQ(90009017.2,CLN,.07) S:X="" X="NO"
  1.  ;;    Rx Profile: ;;S X=$$GET1^DIQ(9009017.2,CLN,.06) S:X="" X="NO"
  1.  ;;;;S X=""
  1.  ;;  Checkin Time: ;;S X=$$GET1^DIQ(44,CLN,24,"I"),X=$S(X=1:"ASK USER",1:"USE CURRENT DATE/TIME")
  1.  ;;Visit Category: ;;S X=$$GET1^DIQ(9009017.2,CLN,.12) S:X="" X="AMBULATORY"
  1.  ;;Multiple Codes: ;;S X=$$GET1^DIQ(9009017.2,CLN,.13) S:X="" X="NO"
  1.  ;;PYXIS Location: ;;S X=$$GET1^DIQ(9009017.2,CLN,,08) S:X="" X="NOT USED"
  1.  ;;;;S X=""
  1.  ;;Require Provider: ;;S X=$$GET1^DIQ(9009017.2,CLN,.14) S:X="" X="NO"