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

SDECU2.m

Go to the documentation of this file.
  1. SDECU2 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**627,658,671**;Aug 13, 1993;Build 25
  1. ;
  1. Q
  1. ;
  1. SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
  1. NEW X,IEN
  1. S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
  1. . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled
  1. . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
  1. Q $G(IEN)
  1. ;
  1. CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
  1. NEW X
  1. S X=$G(SDIEN) ;ien sent in call
  1. I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
  1. S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
  1. Q $S(X:1,1:0)
  1. ;
  1. APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
  1. NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
  1. Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
  1. ;
  1. CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
  1. NEW X
  1. S X=$G(SDIEN) ;ien sent in call
  1. I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
  1. S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
  1. Q $S(X:1,1:0)
  1. ;
  1. GETVST(PAT,DATE) ;PEP; returns visit ien for appt date and patient
  1. NEW X
  1. I ('PAT)!('DATE) Q 0
  1. S X=$G(^DPT(PAT,"S",DATE,0)) I 'X Q 0 ;appt node
  1. S X=$P(X,U,20) I 'X Q 0 ;outpt encounter ptr
  1. S X=$G(^SCE(X,0)) I 'X Q 0 ;outpt encounter node
  1. I $P(X,U,2)'=PAT Q 0 ;patient ptr
  1. Q $P(X,U,5) ;visit ptr
  1. ;
  1. FLAGS(DFN,FNUM) ;get PRF flags
  1. ;INPUT:
  1. ; DFN - Patient ID
  1. ; FNUM - PRF Flag file ID 26.15=PRF NATIONAL FLAG 26.11=PRF LOCAL FLAG
  1. ;RETURN:
  1. ; Each | piece contains the following ;; pieces:
  1. ; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
  1. ; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
  1. ; 3. PRFLID - PRF Local Flag ID pointer to PRF LOCAL FLAG file (#26.11)
  1. ; 4. PRFLNAME - PRF Local Flag name
  1. ; 5. PRFLSTAT - PRF Local Flag status 0=INACTIVE 1=ACTIVE
  1. ;
  1. N PRFAID,PRFID,PRFLST,RET,STAT
  1. S RET=""
  1. S DFN=$G(DFN)
  1. Q:DFN="" ""
  1. Q:'$D(^DPT(DFN,0)) ""
  1. S FNUM=$G(FNUM)
  1. Q:(FNUM'=26.15)&(FNUM'=26.11) ""
  1. D FLST(.PRFLIST,FNUM)
  1. S PRFID="" F S PRFID=$O(PRFLIST(PRFID)) Q:PRFID="" D
  1. .S PRFAID="" F S PRFAID=$O(^DGPF(26.13,"AFLAG",PRFID,DFN,PRFAID)) Q:PRFAID="" D
  1. ..S STAT="" S STAT=$$GET1^DIQ(26.13,PRFAID_",",.03,"I") Q:STAT'=1
  1. ..S RET=RET_$S(RET'="":"|",1:"")_PRFAID_";;"_STAT_";;"_+PRFID_";;"_$P(PRFLIST(PRFID),U,1)_";;"_$P(PRFLIST(PRFID),U,2)
  1. Q RET
  1. FLST(PRFLIST,FNUM) ;build flag list
  1. N PRFID,PRFN
  1. K PRFLIST
  1. S PRFN="" F S PRFN=$O(^DGPF(FNUM,"B",PRFN)) Q:PRFN="" D
  1. .S PRFID="" F S PRFID=$O(^DGPF(FNUM,"B",PRFN,PRFID)) Q:PRFID="" D
  1. ..S PRFLIST(PRFID_";DGPF("_FNUM_",")=$$GET1^DIQ(FNUM,PRFID_",",.01)_U_$$GET1^DIQ(FNUM,PRFID_",",.02,"I")
  1. Q
  1. ;
  1. GAF(DFN) ;determine if GAF score needed
  1. N GAF,GAFR
  1. S GAFR=""
  1. S GAF=$$NEWGAF^SDUTL2(DFN)
  1. S:GAF="" GAF=-1
  1. S $P(GAFR,"|",1)=$S(+GAF:"New GAF Required",1:"No new GAF required")
  1. ;S $P(GAFR,"|",2)=$P(GAF,U,2) ;alb/sat 658 removed 4 lines
  1. ;S $P(GAFR,"|",3)=$$FMTE^XLFDT($P(GAF,U,3))
  1. ;S $P(GAFR,"|",4)=$P(GAF,U,4)
  1. ;S $P(GAFR,"|",5)=$P($G(^VA(200,+$P(GAF,U,4),0)),U,1)
  1. Q GAFR
  1. ;
  1. ETH(DFN,PETH,PETHN) ;get ethnicity list
  1. ;INPUT:
  1. ; DFN = Patient ID pointer to PATIENT file
  1. ;RETURN:
  1. ; PETH - Patient Ethnicity list separated by pipe |
  1. ; Pointer to ETHNICITY file 10.2
  1. ; PETHN - Patient Ethnicity names separated by pipe |
  1. N SDI,SDID
  1. S (PETH,PETHN)=""
  1. S SDI=0 F S SDI=$O(^DPT(DFN,.06,SDI)) Q:SDI'>0 D
  1. .S SDID=$P($G(^DPT(DFN,.06,SDI,0)),U,1)
  1. .S PETH=$S(PETH'="":PETH_"|",1:"")_SDID
  1. .S PETHN=$S(PETHN'="":PETHN_"|",1:"")_$P($G(^DIC(10.2,SDID,0)),U,1)
  1. Q
  1. RACELST(DFN,RACEIEN,RACENAM) ;get list of race information for given patient
  1. ;INPUT:
  1. ; DFN = Patient ID pointer to PATIENT file
  1. ;RETURN:
  1. ; RACEIEN - Patient race list separated by pipe |
  1. ; Pointer to RACE file 10
  1. ; RACENAM - Patient race names separated by pipe |
  1. N SDI,SDID
  1. S (RACEIEN,RACENAM)=""
  1. S SDI=0 F S SDI=$O(^DPT(DFN,.02,SDI)) Q:SDI'>0 D
  1. .S SDID=$P($G(^DPT(DFN,.02,SDI,0)),U,1)
  1. .S RACEIEN=$S(RACEIEN'="":RACEIEN_"|",1:"")_SDID
  1. .S RACENAM=$S(RACENAM'="":RACENAM_"|",1:"")_$P($G(^DIC(10,SDID,0)),U,1)
  1. Q