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

SDEC32.m

Go to the documentation of this file.
  1. SDEC32 ;ALB/SAT,DMR - VISTA SCHEDULING RPCS ;JUL 26, 2017
  1. ;;5.3;Scheduling;**627,643,642,658,665,672,679,781,796,797**;Aug 13, 1993;Build 8
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. Q
  1. ;
  1. ;
  1. ERROR ;
  1. D ERR("VistA Error")
  1. Q
  1. ;
  1. ERR(SDECERR) ;Error processing
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs
  1. ;HOSPLOC(SDECY) external parameter tag is in SDEC
  1. ;INPUT:
  1. ; SDECP - (optional) Partial name text
  1. ; MAXREC - (optional) Max number of records to return
  1. ; LSUB - (optional) subscripts from last call to pick up where left off
  1. ;RETURN:
  1. ;Global Array in which each array entry
  1. ;contains HOSPITAL LOCATION data separated by ^:
  1. ; 1. HOSPITAL_LOCATION_ID
  1. ; 2. HOSPITAL_LOCATION
  1. ; 3. DEFAULT_PROVIDER
  1. ; 4. STOP_CODE_NUMBER
  1. ; 5. INACTIVATE_DATE
  1. ; 6. REACTIVATE_DATE
  1. ; 7. LASTSUB
  1. N SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD
  1. N SDECIEN1,SDECPRV,SDDUP,SDNAM
  1. N LASTSUB,X
  1. K ^TMP("SDEC",$J)
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. S SDECI=0
  1. S ^TMP("SDEC",$J,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$C(30)
  1. ;
  1. S SDECP=$G(SDECP)
  1. S MAXREC=+$G(MAXREC)
  1. S LSUB=$G(LSUB)
  1. S:LSUB="" SDECNAM=$S(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"")
  1. S:LSUB'="" SDECNAM=$$GETSUB^SDEC56($P(LSUB,"|",1))
  1. F S SDECNAM=$O(^SC("B",SDECNAM)) Q:(SDECP'="")&(SDECNAM'[SDECP) Q:SDECNAM="" D Q:(+MAXREC)&(SDECI'<MAXREC)
  1. . S SDECIEN=$S(LSUB'="":$P(LSUB,"|",2),1:0) S LSUB="" F S SDECIEN=$O(^SC("B",SDECNAM,SDECIEN)) Q:SDECIEN'>0 D Q:(+MAXREC)&(SDECI'<MAXREC)
  1. .. Q:'+SDECIEN>0
  1. .. Q:'$D(^SC(+SDECIEN,0))
  1. .. Q:$$INACTIVE(+SDECIEN)
  1. .. Q:+$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1 ;OOS?
  1. .. S SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505) ;INACTIVATE
  1. .. S SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506) ;REACTIVATE
  1. .. S SDECNOD=^SC(SDECIEN,0)
  1. .. Q:$D(SDDUP(+SDECIEN))
  1. .. S SDDUP(+SDECIEN)=""
  1. .. S SDNAM=$P(SDECNOD,U)
  1. .. S SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8) ;STOP CODE
  1. .. ;Calculate default provider
  1. .. S SDECPRV=""
  1. .. I $D(^SC(SDECIEN,"PR")) D
  1. ... S SDECIEN1=0 F S SDECIEN1=$O(^SC(SDECIEN,"PR",SDECIEN1)) Q:'+SDECIEN1 Q:SDECPRV]"" D
  1. .... S SDECNOD1=$G(^SC(SDECIEN,"PR",SDECIEN1,0))
  1. .... S:$P(SDECNOD1,U,2)="1" SDECPRV=$$GET1^DIQ(200,$P(SDECNOD1,U),.01)
  1. .... Q
  1. ... Q
  1. .. S LASTSUB=SDECNAM_"|"_SDECIEN
  1. .. S SDECI=SDECI+1
  1. .. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$C(30)
  1. .. Q
  1. I SDECNAM="",SDECIEN="" S $P(^TMP("SDEC",$J,SDECI),U,7)="" ;clear lastsub for last entry if finished
  1. S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
  1. K SDDUP
  1. Q
  1. ;
  1. CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file
  1. ;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC
  1. ;INPUT:
  1. ; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability
  1. ; SDIENS - IENs for individual hospital locations separated by pipes
  1. ; SDNOLET - flag to include clinics with no Recall Letter defined
  1. ; in RECALL REMINDERS LETTERS file
  1. ; 0 = yes (include all clinics including those with no Recall Letter
  1. ; defined) [default]
  1. ; 1 = no (only return clinics with a Recall Letter
  1. ; defined)
  1. ;Returns CLINIC SETUP PARAMETERS file entries for clinics which
  1. ;are active in ^SC (#44)
  1. ;MGH Added SDIENS as input parameter to for hospital location IENs
  1. ;MGH Added SDECP for partial name lookup
  1. ;RETURN
  1. ; Global Array in which each array entry contains the following Clinic data separated by ^:
  1. ; 1. HOSPITAL_LOCATION_ID
  1. ; 2. HOSPITAL_LOCATION
  1. ; 3. CREATE_VISIT
  1. ; 4. VISIT_SERVICE_CATEGORY
  1. ; 5. MULTIPLE_CLINIC_CODES_USED?
  1. ; 6. VISIT_PROVIDER_REQUIRED
  1. ; 7. GENERATE_PCCPLUS_FORMS?
  1. ; 8. MAX_OVERBOOKS
  1. ; 9. SDECDAT
  1. ;10. SDECDATN
  1. ;11. APPTLEN - 1912 Appointment Length Numeric 10-240
  1. ;12. VAPPTLEN
  1. ;13. SLOTS
  1. ;14. PRIVUSERPRESENT_BOOL
  1. ;15. PROTECTED
  1. ;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins
  1. ;17. DISPLAY_INCREMENTS - 1917 Display increments per hour
  1. ; 1=60-MIN
  1. ; 2=30-MIN
  1. ; 4=15-MIN
  1. ; 3=20-MIN
  1. ; 6=10-MIN
  1. ;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES
  1. ;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10)
  1. ;20. CLINIC_STOP - 8 Stop code Number pointer to CLINIC STOP in file 40.7
  1. ;21. ABBREVIATION - 1 Abbrevation
  1. ;22. not used ??
  1. ;23. DEFAULT_VIEW - Scheduling default view
  1. ;24. VVC Indicator - Inicator if this clinic is considered a VVC clinic (1=Yes 0=No)
  1. N SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP ;alb/sat 665 - add SDF
  1. N SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX ;alb/sat 665 - add vars
  1. N SDARR1,SDREF,SDXT,SDV ;alb/sat 672
  1. K ^TMP("SDEC",$J)
  1. S (SDCNT,SDMAX)=0
  1. S SDF=""
  1. S SDV="" ;alb/sat 672
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. S SDECI=0
  1. ; 1 2 3 4
  1. S SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY"
  1. ; 5 6 7
  1. S SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?"
  1. ; 8 9 10 11 12 13 14
  1. S SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL"
  1. ; 15 16 17 18
  1. S SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP"
  1. ; 21 22 23
  1. S SDTMP=SDTMP_"^T00030ABBR^T00030MORE^T00030DEFAULT_VIEW" ;alb/sat 672 - add DEFAULT_VIEW
  1. ; 24
  1. S SDTMP=SDTMP_"^T00030VVC_CLINIC" ; VVC_Indicator
  1. S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
  1. ;
  1. S (SDECDAT,SDECDATN)=""
  1. S SDNOSLOT=$G(SDNOSLOT)
  1. S SDNOLET=$G(SDNOLET)
  1. S MAXREC=$G(MAXREC,50)
  1. ;MGH change made for individual locations
  1. I $G(SDIENS) D
  1. .F SDK=1:1:$L(SDIENS,"|") D
  1. ..S SDECIEN=$P(SDIENS,"|",SDK)
  1. ..D PROCESS(SDECIEN)
  1. ;MGH change made for partial name lookup
  1. I $G(SDECP)'="" D
  1. .;alb/sat 672 - begin modification; separate string and numeric lookup
  1. .S (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP)
  1. .;abbreviation as string
  1. .S SDF="ABBRSTR" D
  1. ..S SDREF="C" D PART Q
  1. .;abbreviation as numeric
  1. .S SDF="ABBRNUM",SDECNAM=SDXT_" " D
  1. ..S SDREF="C" D PART Q
  1. .;name as string
  1. .S SDF="FULLSTR",SDECNAM=SDXT D
  1. ..S SDREF="B" D PART Q
  1. .;name as numeric
  1. .S SDF="FULLNUM",SDECNAM=SDXT_" " D
  1. ..S SDREF="B" D PART Q
  1. .;alb/sat 672 - end modification; separate string and numeric lookup
  1. I $G(SDIENS)=""&($G(SDECP)="") S SDECIEN=0 F S SDECIEN=$O(^SC(SDECIEN)) Q:SDECIEN'>0 D
  1. .D PROCESS(SDECIEN)
  1. S SDL=-1 F S SDL=$O(SDAR(SDL)) Q:SDL="" D
  1. .S SDI="" F S SDI=$O(SDAR(SDL,SDI)) Q:SDI="" D
  1. ..S SDJ="" F S SDJ=$O(SDAR(SDL,SDI,SDJ)) Q:SDJ="" D
  1. ...S SDTMP=SDAR(SDL,SDI,SDJ)
  1. ...S $P(SDTMP,U,22)=$S(+SDMAX:1,1:0)
  1. ...S SDECI=SDECI+1
  1. ...S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
  1. S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
  1. Q
  1. PART ;partial name lookup ;alb/sat 672
  1. Q:SDREF=""
  1. F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'<MAXREC S SDECNAM=$O(^SC(SDREF,SDECNAM)) S SDMAX=$S(+SDMAX:1,SDECNAM[SDECP:1,1:0) Q ;alb/sat 658 - abbreviation lookup if characters length 7 or less
  1. .S SDECIEN=0 F S SDECIEN=$O(^SC(SDREF,SDECNAM,SDECIEN)) Q:SDECIEN="" D PROCESS(SDECIEN) I SDCNT'<MAXREC S SDMAX=+$O(^SC(SDREF,SDECNAM,SDECIEN)) Q ;alb/sat 665 loop thru all entries
  1. Q
  1. PROCESS(SDECIEN) ;Process an individual clinic
  1. ;MGH broke this out to do all locations or individual ones
  1. N SDECABR,SDECNAM,SDI,SDI1,SDDI,SDH,SDHDB,SDSP,SDSTOP
  1. N SDVVC,SDCRSTOP
  1. Q:'$D(^SC(+SDECIEN,0))
  1. ;Q:$$INACTIVE(+SDECIEN) ;SD,796
  1. I SDNOLET,'$O(^SD(403.52,"B",+SDECIEN,0)) Q
  1. D RESCLIN1^SDEC01B(SDECIEN)
  1. S SDSLOTS=""
  1. K SDDATA,SDMSG
  1. S SDFIELDS=".01;1;2;8;50.01;1912;1913;1914;1917;1918;1918.5"_$S(SDNOSLOT:"",1:";1920*")_";2503;2505;2506;2507" ;alb/sat 665 - add abbreviation
  1. D GETS^DIQ(44,SDECIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. Q:$G(SDDATA(44,SDECIEN_",",2,"I"))'="C"
  1. Q:+$G(SDDATA(44,SDECIEN_",",50.01,"I"))=1 ;OOS?
  1. Q:$D(SDARR1(SDECIEN)) ;alb/sat 672 - checking for duplicates
  1. S SDARR1(SDECIEN)="" ;alb/sat 672 - checking for duplicates
  1. S SDA="SDDATA(44,"""_SDECIEN_","")"
  1. S SDAPLEN=@SDA@(1912,"E") ;length of appointment
  1. S SDVAPL=@SDA@(1913,"I") ;variable appointment length V means yes
  1. S SDHDB=@SDA@(1914,"E") ;hour clinic display begins
  1. S:SDHDB="" SDHDB=8
  1. S SDDI=@SDA@(1917,"I") ;display increments per hour
  1. S SDECINA=@SDA@(2505,"E") ;INACTIVATE
  1. S SDECREA=@SDA@(2506,"E") ;REACTIVATE
  1. S SDECDAT=@SDA@(2507,"I") ;DEFAULT APPOINTMENT TYPE ien
  1. S SDECDATN=@SDA@(2507,"E") ;DEFAULT APPOINTMENT TYPE name
  1. S SDSTOP=@SDA@(8,"I") ;STOP CODE NUMBER
  1. S SDECNAM=@SDA@(.01,"E")
  1. S SDECABR=@SDA@(1,"E") ;alb/sat 665
  1. S SDECNAM=$S((SDF["ABBR")&(@SDA@(1,"E")'=""):@SDA@(1,"E")_" ",1:"")_SDECNAM ;alb/sat 665 - include abbr in name if found by C xref
  1. S SDECMOB=@SDA@(1918,"E")
  1. S SDH=@SDA@(1918.5,"I")
  1. S SDECCRV=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.09) ;Create Visit at Check-In?
  1. S SDECVSC="" ;$$GET1^DIQ(9009017.2,SDECIEN_",",.12) ;Visit Service Category
  1. S SDECMULT=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.13) ;Multiple Clinic codes used?
  1. S SDECREQ=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.14) ;Visit Provider Required
  1. S SDECPCC=0 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.15) ;Generate PCCPlus Forms?
  1. S:'SDNOSLOT SDSLOTS=$$GETSLOTS(.SDDATA)
  1. S SDECHPRV=$O(^SC(+SDECIEN,"SDPRIV",0))>0
  1. S SDECPROT=$G(^SC(+SDECIEN,"SDPROT"))="Y"
  1. S SDSP="" S SDI=0 F S SDI=$O(^SC(+SDECIEN,"SI",SDI)) Q:SDI'>0 S SDI1=$G(^SC(+SDECIEN,"SI",SDI,0)) S:SDI1'="" SDSP=$S(SDSP'="":SDSP_$C(13,10),1:"")_SDI1
  1. S:SDECNAM'="" SDV=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",SDECNAM,"B") ;alb/sat 672
  1. S SDV=$S(SDV'="":$P(SDV,U,1),1:"W") ;alb/sat 672
  1. S SDVVC=0
  1. S SDCRSTOP=@SDA@(2503,"I") ;CREDIT STOP CODE NUMBER
  1. I SDSTOP S SDVVC=$$VVCSTPCD(SDSTOP)
  1. I 'SDVVC,SDCRSTOP S SDVVC=$$VVCSTPCD(SDCRSTOP)
  1. ; 1 2 3 4 5 6 7 8
  1. S SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB
  1. ; 9 10 11 12 13 14 15
  1. S SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT
  1. ; 16 17 18 19 20 21 22 23
  1. S SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR_U_U_SDV ;alb/sat 672 - add SDV
  1. ; 24
  1. S SDTMP=SDTMP_U_SDVVC ; ??? - add SDVVC
  1. S SDAR(SDF["FULL",SDECNAM,SDECIEN)=SDTMP
  1. S SDCNT=SDCNT+1
  1. Q
  1. CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations ;alb/sat 672 - removed
  1. Q
  1. N FND,SDR,SDX
  1. S FND=0
  1. S SDX=$$GETSUB^SDEC56(SDECP)
  1. F S SDX=$O(^SC("C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND
  1. .S SDR=0 F S SDR=$O(^SC("C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECIEN Q:+FND
  1. Q FND
  1. ;
  1. ;
  1. GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44
  1. ;INPUT:
  1. ; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from
  1. N SDI,SDDT,SDSLOTS
  1. S SDSLOTS=""
  1. S SDI="" F S SDI=$O(SDDATA(44.004,SDI)) Q:SDI="" D
  1. .S SDDT=$P(SDI,",",2) ;get date
  1. .S SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I") ;get time
  1. .S SDDT=$$FMTE^XLFDT(SDDT)
  1. .S SDSLOTS=$S(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E")
  1. Q SDSLOTS
  1. ;
  1. INACTIVE(SDCL,SDDT) ;determine if clinic is active
  1. ; X=0=ACTIVE
  1. ; X=1=INACTIVE
  1. N SDNODI,N21,N25,X
  1. S SDDT=$G(SDDT) I SDDT="" S SDDT=DT
  1. S SDDT=$P(SDDT,".",1)
  1. S X=1
  1. S SDNODI=$G(^SC(SDCL,"I"))
  1. Q:SDNODI="" 0
  1. S N21=$P(SDNODI,U,1) ;inactive date/time
  1. S N25=$P(SDNODI,U,2) ;reactive date/time
  1. I (N21="") S X=0 Q X
  1. I (N21'="")&(N21>SDDT) S X=0 Q X
  1. I (N25'="")&(N25'>SDDT) S X=0 Q X
  1. Q X
  1. ;
  1. PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic
  1. ;INPUT:
  1. ; CLINIEN - pointer to HOSPITAL LOCATION file 44
  1. ; USER - pointer to NEW PERSON file 200
  1. ;RETURN:
  1. ; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic.
  1. ; RETURNCODE - 0=NO; 1=YES; -1=error
  1. ; MESSAGE
  1. N SDRET
  1. S SDECY="^TMP(""SDEC32"","_$J_",""PRIV"")"
  1. K @SDECY
  1. S @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$C(30)
  1. S CLINIEN=$G(CLINIEN)
  1. I (CLINIEN="")!('$D(^SC(CLINIEN,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
  1. S USER=$G(USER)
  1. I (USER="")!('$D(^VA(200,USER,0))) S @SDECY@(1)="-1^Invalid user ID."_$C(30,31) Q
  1. S SDRET=$D(^SC(CLINIEN,"SDPRIV",USER,0))
  1. S $P(SDRET,U,2)=$S(SDRET=1:"YES",1:"NO")
  1. S @SDECY@(1)=SDRET_$C(30,31)
  1. Q
  1. ;
  1. BOOKHLDY(SDECY,SDECCL) ; Returns can book on holiday flag for a clinic. 12/1/17 wtc 679
  1. ;
  1. ; Returns value of field 1918.5 in file #44
  1. ;
  1. ; SDECY = return value
  1. ; SDECCL = pointer to file #44
  1. ;
  1. S SDECY="" ;
  1. Q:$G(SDECCL)="" ;
  1. S SDECY=$P($G(^SC(SDECCL,"SL")),"^",8) ;
  1. Q ;
  1. ;
  1. VVCSTPCD(STOPCD) ;
  1. ; Called from PROCES tag above
  1. ;
  1. ;Input:
  1. ; STOPCD - a stop code
  1. ;
  1. ;Return:
  1. ; 1 = Stop code is found in the SDEC SETTING file (#409.98) field 7 VVC STOP CODE
  1. Q:'$G(STOPCD)
  1. N RETURN,STOP
  1. ;
  1. S RETURN=0
  1. S STOP="" S STOP=$$GET1^DIQ(40.7,STOPCD,1)
  1. I STOP>0 D
  1. .I $D(^SDEC(409.98,1,3,"B",STOP)) S RETURN=1
  1. Q RETURN