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

SDEC01C.m

Go to the documentation of this file.
  1. SDEC01C ;ALB/AJF,DJS - VISTA SCHEDULING RPCS ;SEP 12, 2022
  1. ;;5.3;Scheduling;**686,825**;;Build 2
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;Returns ADO Recordset with ALL RESOURCE names
  1. ; SDECDUZ = (optional) pointer to NEW PERSON file
  1. ; Defaults to current user
  1. ; checks that overbook is allowed
  1. ; SDACT = (optional) 1 or YES will return only active resources
  1. ; 0, NO, or null will include inactive
  1. ; SDTYPE = (optional) null will return all resource types
  1. ; H will only return HOSPITAL LOCATION (clinic) resources
  1. ; P will only return NEW PERSON (Provider) resources
  1. ; A will only return SDEC ADDITIONAL RESOURCE resources
  1. ; PH will only return prohibited clinics
  1. ; MAXREC - (optional) Max records returned
  1. ; LASTSUBI - (optional) last subscripts from previous call
  1. ; SDIEN - (optional) pointer to SDEC RESOURCE file
  1. ; only 1 record will be returned if SDIEN is present
  1. ; SDECP - (optional) Partial name text
  1. ;RETURN:
  1. ; Successful Return:
  1. ; a global array in which each array entry contains data from the
  1. ; SDEC RESOURCE file
  1. ; 1. RESOURCEID - Pointer to the SDEC RESOURCE file
  1. ; 2. HOSPITALID - Pointer to the HOSPITAL LOCATION file 44
  1. ; 3. CLINNAME - Clinic Name from HOSPITAL LOCATION file 44
  1. ; 4. ABBR - Abbreviation
  1. ; 5. RESOURCE_NAME - NAME from SDEC RESOURCE file
  1. ; 6. E-CHECKIN_ALLOWED
  1. ; 7. PRE-CHECKIN_ALLOWED
  1. ; 8. TIME_ZONE
  1. ;
  1. ;
  1. N SDA,SDCL,SDDATA,SDMSG,SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI,SDEC,SDECLTR
  1. N ABBR,SDECNOS,SDECCAN,SDF,SDTYPR,SDX,SDPRO,PRO,SDH,SDK,SDRT,SDT,SDXT,SDCN,SDHL
  1. S (SDF,SDRT,SDT,SDX)="",SDPRO=0
  1. S SDECY="^TMP(""SDEC01C"","_$J_",""RESOURCE"")"
  1. K @SDECY
  1. S SDECI=0
  1. S (SDECERR,SDTYPR)=""
  1. ; 1 2 3
  1. S @SDECY@(SDECI)="I00010RESOURCEID^I00010HOSPITAL_LOCATION_ID^T00030CLINNAME^T00030ABBR^T00030RESOURCE_NAME^T00030E-CHECKIN_ALLOWED^T00030PRE-CHECKIN_ALLOWED^T00030TIME_ZONE"_$C(30)
  1. ;validate user
  1. S SDECDUZ=$G(SDECDUZ)
  1. I '+SDECDUZ S SDECDUZ=DUZ
  1. ;validate active
  1. S SDACT=1
  1. ;S SDACT=$G(SDACT)
  1. ;S SDACT=$S(SDACT=1:1,SDACT="YES":1,1:0)
  1. ;validate type
  1. S SDTYPE="H"
  1. ;MGH added new type
  1. ;I SDTYPE="PH" S SDPRO=1
  1. S SDTYPE=$S(SDTYPE="H":"SC(",SDTYPE="P":"VA(200",SDTYPE="A":"SDEC",1:"")
  1. ;validate MAXREC
  1. S MAXREC=$G(MAXREC,9999999)
  1. ;validate LASTSUBI
  1. S LASTSUBI=$G(LASTSUBI)
  1. ;validate SDIEN
  1. ;MGH changed to allow multiple IENS
  1. S SDIEN=$G(SDIEN)
  1. I SDIEN'="",'$D(^SDEC(409.831,+SDIEN,0)) S SDIEN=""
  1. I $G(SDIEN) D G RESX
  1. .F SDK=1:1:$L(SDIEN,"|") D
  1. ..S SDECIEN=$P(SDIEN,"|",SDK)
  1. ..Q:'$D(^SDEC(409.831,+SDECIEN,0))
  1. ..S SDECRES=SDECIEN
  1. ..D RES1
  1. ;ien lookup
  1. ;I +SDIEN S SDECRES=+SDIEN D RES1 G RESX
  1. ;validate SDECP
  1. S SDECP=$G(SDECP)
  1. ;partial name lookup
  1. I SDECP'="" D
  1. .S SDF=$S($P(LASTSUBI,"|",1)'="":$P(LASTSUBI,"|",1),1:"")
  1. .S (SDX,SDXT)=$S($P(LASTSUBI,"|",2)'="":$$GETSUB^SDEC56($P(LASTSUBI,"|",2)),1:$$GETSUB^SDEC56(SDECP))
  1. .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBR") S SDF="ABBR" F S SDX=$O(^SDEC(409.831,"C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:(+MAXREC)&(SDECI'<MAXREC)
  1. ..S (SDECRES,SDRT)=$S($P(LASTSUBI,"|",3)'="":$P(LASTSUBI,"|",3),1:0)
  1. ..S LASTSUBI="" F S SDECRES=$O(^SDEC(409.831,"C",SDX,SDECRES)) Q:'+SDECRES D RES1 Q:(+MAXREC)&(SDECI'<MAXREC)
  1. .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="FULL") S SDF="FULL",SDX=SDXT F S SDX=$O(^SDEC(409.831,"B",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:(+MAXREC)&(SDECI'<MAXREC)
  1. ..S (SDECRES,SDRT)=$S($P(LASTSUBI,"|",3)'="":$P(LASTSUBI,"|",3),SDRT'="":SDRT,1:0)
  1. ..S LASTSUBI="" F S SDECRES=$O(^SDEC(409.831,"B",SDX,SDECRES)) Q:'+SDECRES D RES1 Q:(+MAXREC)&(SDECI'<MAXREC)
  1. ;$O THRU SDEC RESOURCE File
  1. I SDECP="",'+SDIEN S SDECRES=$S($P(LASTSUBI,"|",2)'="":$P(LASTSUBI,"|",2),1:0) F S SDECRES=$O(^SDEC(409.831,SDECRES)) Q:'+SDECRES D Q:(+MAXREC)&(SDECI'<MAXREC)
  1. .D RES1
  1. RESX ;
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. RES1 ; get data for 1 resource
  1. N FND
  1. S FND=0
  1. Q:'$D(^SDEC(409.831,SDECRES,0))
  1. I SDF="FULL",SDECP'="" S FND=$$CHK(SDECP,SDECRES) Q:+FND ;alb/sat 658 - stop if 'this' record found in abbreviations
  1. I SDECP'="" S SDH=0 F S SDH=$O(^SDEC(409.831,"C",SDECP,SDH)) Q:SDH="" S FND=SDH=SDECRES Q:FND
  1. S SDECRNOD=^SDEC(409.831,SDECRES,0)
  1. I SDTYPE'="" Q:$P(SDECRNOD,U,11)'[SDTYPE
  1. S SDTYPR=$P(SDECRNOD,U,11)
  1. S $P(SDTYPR,"|",1)=$S($P(SDTYPR,";",2)="SC(":"H",$P(SDTYPR,";",2)="VA(200,":"P",$P(SDTYPR,";",2)="SDEC(409.834,":"A",1:"")
  1. S $P(SDTYPR,"|",2)=$P($P(SDECRNOD,U,11),";",1)
  1. S $P(SDTYPR,"|",3)=$$GET1^DIQ(409.831,SDECRES_",",.012)
  1. I $P(SDTYPR,"|",1)="P" D RESPRV1^SDEC01B($P(SDTYPR,"|",2),$P(SDECRNOD,U,4)) ;do not include provider resource if NEW PERSON is not active
  1. I $P(SDTYPR,"|",1)="H" D CHKC^SDEC01B($P(SDTYPR,"|",2),SDECRES)
  1. I +SDACT,$$GET1^DIQ(409.831,SDECRES_",",.02)="YES" Q ;do not include inactive entries
  1. D GETACC(.SDECACC,SDECDUZ,SDECRES)
  1. K SDECRDAT
  1. ;alb/sat 658 - begin mod
  1. ;
  1. S $P(SDECRDAT,U,1)=$P(SDECRNOD,U,1)
  1. S $P(SDECRDAT,U,2)=$P(SDECRNOD,U,2)
  1. S $P(SDECRDAT,U,3)=$P(SDECRNOD,U,3)
  1. S $P(SDECRDAT,U,4)=$P(SDECRNOD,U,4)
  1. S SDHL=$P(SDECRNOD,U,4)
  1. S SDCN=$$GET1^DIQ(44,SDHL_",",.01) ;clinic name
  1. ;alb/sat 658 - end mod
  1. S SDECRDAT=SDECRES_U_SDECRDAT ;1,2-5
  1. S SDCL=$P(SDECRDAT,U,5)
  1. Q:+$$GET1^DIQ(44,SDCL_",",50.01,"I")=1 ;OOS?
  1. S PRO=0
  1. ;MGH code for new type to only contain prohibited clinics
  1. Q:$G(SDCL)=""&(SDPRO=1)
  1. Q:$G(SDCL)&(SDPRO=1)&($$GET1^DIQ(44,SDCL_",",2500)'="YES")
  1. S $P(SDECRDAT,U,3)=$$GET1^DIQ(409.831,SDECRES_",",.02)
  1. ;Get letter text from wp field
  1. S SDECLTR=""
  1. I 0,$D(^SDEC(409.831,SDECRES,1)) D
  1. . S SDECIEN=0
  1. . F S SDECIEN=$O(^SDEC(409.831,SDECRES,1,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,1,SDECIEN,0))
  1. . . S SDECLTR=SDECLTR_$C(13)_$C(10)
  1. S SDECNOS=""
  1. I 0,$D(^SDEC(409.831,SDECRES,12)) D
  1. . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,12,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,12,SDECIEN,0))
  1. . . S SDECNOS=SDECNOS_$C(13)_$C(10)
  1. S SDECCAN=""
  1. I 0,$D(^SDEC(409.831,SDECRES,13)) D
  1. . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,13,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,13,SDECIEN,0))
  1. . . S SDECCAN=SDECCAN_$C(13)_$C(10)
  1. N SDECACC,SDECMGR
  1. S SDECACC="0^0^0^0"
  1. S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0))
  1. I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1"
  1. I SDECACC="0^0^0^0" D
  1. . N SDECNOD,SDECRUID
  1. . S SDECRUID=0
  1. . ;Get entry for this user and resource
  1. . F S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q
  1. . Q:'+SDECRUID
  1. . S $P(SDECACC,U)=1
  1. . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0))
  1. . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3)
  1. . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4)
  1. . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5)
  1. ; 6 7 8 9-12
  1. K SDDATA D GETS^DIQ(409.831,SDECRES_",",".01:.04","IE","SDDATA","SDMSG")
  1. S SDA="SDDATA(409.831,"""_SDECRES_","")"
  1. S ABBR=@SDA@(.011,"E") ;abbreviation
  1. ;AJF ; 022718 ; Only return 7 variables
  1. S SDECRDAT=SDECRES_U_SDHL_U_SDCN_U_ABBR_U_$P(SDECRNOD,U)
  1. ;S SDECRDAT=SDECRES_U_SDHL_U_SDCN
  1. S $P(SDECRDAT,U,4)=@SDA@(.011,"E") ;abbreviation
  1. S $P(SDECRDAT,U,5)=$S(($G(SDF)="ABBR")&(@SDA@(.011,"E")'=""):@SDA@(.011,"E")_" ",1:"")_$P(SDECRDAT,U,5) ;alb/sat 658 - include abbr in name if found by C xref
  1. ;S $P(SDECRDAT,U,6)=SDF_"|"_SDX_"|"_SDECRES ;LASTSUB
  1. ;
  1. ;DJS ; VSE-3428 ADD E-CHECKIN ALLOWED, PRE-CHECKIN ALLOWED & TIME ZONE
  1. ;
  1. N SDECHIN,SDPRECHIN,SDTMZN
  1. D ADDFLDS
  1. S SDECRDAT=SDECRDAT_U_SDECHIN_U_SDPRECHIN_U_SDTMZN
  1. S SDECI=SDECI+1
  1. S @SDECY@(SDECI)=SDECRDAT_$C(30)
  1. Q
  1. ;
  1. GETACC(SDECACC,SDECDUZ,SDECRES) ;get view, overbook, modify appt, and modify schedule abilities
  1. ;INPUT:
  1. ; SDECDUZ = user ID pointer to NEW PERSON file
  1. ; SDECRES = resource ID pointer to SDEC RESOURCE file
  1. ;RETURN:
  1. ; .SDECACC = access separated by ^:
  1. ; 1. VIEW - User can VIEW 1=YES; 0=NO
  1. ; 2. OVERBOOK - User can OVERBOOK 1=YES; 0=NO
  1. ; 3. MODIFY SCHEDULE - User can Modify Schedule 1=YES; 0=NO
  1. ; 4. MODIFY APPOINTMENTS User can modify appointments 1=YES; 0=NO
  1. N SDECMGR
  1. S SDECACC="0^0^0^0"
  1. S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0))
  1. I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1"
  1. I SDECACC="0^0^0^0" D
  1. . N SDECNOD,SDECRUID
  1. . S SDECRUID=0
  1. . ;Get entry for this user and resource
  1. . F S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q
  1. . Q:'+SDECRUID
  1. . S $P(SDECACC,U)=1
  1. . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0))
  1. . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3)
  1. . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4)
  1. . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5)
  1. Q
  1. ;
  1. GETLTRS(SDECLTR,SDECNOS,SDECCAN,SDECRES,SDCL) ;get resource letters
  1. ;INPUT:
  1. ; SDECRES = resource ID pointer to SDEC RESOURCE file
  1. ; SDCL = clinic ID pointer to HOSPITAL LOCATION file
  1. ;RETURN:
  1. ; .SDECLTR = LETTER TEXT
  1. ; .SDECNOS = NO SHOW LETTER
  1. ; .SDECCAN = CLINIC CANCELLATION LETTER
  1. ; .Get letter text from wp field
  1. N SDECIEN
  1. S SDECLTR=""
  1. I $D(^SDEC(409.831,SDECRES,2,SDCL,1)) D
  1. . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN,0))
  1. . . S SDECLTR=SDECLTR_$C(13)_$C(10)
  1. S SDECNOS=""
  1. I $D(^SDEC(409.831,SDECRES,2,SDCL,12)) D
  1. . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN,0))
  1. . . S SDECNOS=SDECNOS_$C(13)_$C(10)
  1. S SDECCAN=""
  1. I $D(^SDEC(409.831,SDECRES,13)) D
  1. . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN)) Q:'+SDECIEN D
  1. . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN,0))
  1. . . S SDECCAN=SDECCAN_$C(13)_$C(10)
  1. Q
  1. ;
  1. CHK(SDECP,SDECRES) ;alb/sat 658 - stop if 'this' record found in abbreviations
  1. N FND,SDR,SDX
  1. S FND=0
  1. S SDX=$$GETSUB^SDEC56(SDECP)
  1. F S SDX=$O(^SDEC(409.831,"C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND
  1. .S SDR=0 F S SDR=$O(^SDEC(409.831,"C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECRES Q:+FND
  1. Q FND
  1. ;
  1. ADDFLDS ; ADD E-CHECKIN ALLOWED, PRE-CHECKIN ALLOWED AND TIME ZONE TO OUTPUT
  1. S SDECHIN=$$GET1^DIQ(44,SDCL_",",20,"I")
  1. S SDPRECHIN=$$GET1^DIQ(44,SDCL_",",21,"I")
  1. S SDTMZN=$$TIMEZONEDATA^SDESUTIL($G(SDCL)),SDTMZN=$P($G(SDTMZN),U)
  1. Q