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

SCUTBK11.m

Go to the documentation of this file.
  1. SCUTBK11 ;ALB/SCK - Scheduling Broker Utilities; 2/2/96 ;9/7/96 17:28
  1. ;;5.3;Scheduling;**41,54,86,148,177,205,209,255,297**;AUG 13, 1993
  1. ;
  1. Q
  1. PARSE(SC) ;
  1. S SCDFN=$G(SC("DFN"),"")
  1. S SCPIEN=$G(SC("PIEN"),"")
  1. S:$D(SC("TEAM")) SCTM=$G(SC("TEAM"))
  1. S:$D(SC("BEGIN")) SCDT("BEGIN")=$G(SC("BEGIN"))
  1. S:$D(SC("END")) SCDT("END")=$G(SC("END"))
  1. I $D(SC("END")) S SCDT("INCL")=0
  1. S SCFILE=$G(SC("FILE"))
  1. S SCIEN=$G(SC("IEN"))
  1. S SCFIELD=$G(SC("FIELD"))
  1. S SCVAL=$G(SC("VALUE"))
  1. Q
  1. ;
  1. TMLST(SCDATA,SC) ;
  1. ; -- Return a list of teams for a patient. Pass in the DFN and
  1. ; optionally a date range and/or a team purpose to restrict the
  1. ; team look up. Return only the team entry, strip out any other
  1. ; array items.
  1. ;
  1. N DFN,SCDT,SCPURP,SCLIST,SCER1,SCOK,SCD
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. S DFN=$G(SC("DFN"))
  1. S SCDT("BEGIN")=$G(SC("BEGIN"),"")
  1. I $L(SCDT("BEGIN"))>2 S SCDT("INCL")=$G(SC("INCL"),0)
  1. S SCDT("END")=$G(SC("END"),"")
  1. S SCPURP=$G(SC("PURP"),"")
  1. ;
  1. S SCOK=$$TMPT^SCAPMC3(DFN,"SCDT","","SCD","SCER1")
  1. ;
  1. S I=0 F S I=$O(SCD(I)) Q:'I S SCDATA(I)=SCD(I)
  1. TMQ Q
  1. ;
  1. FINDP(SCOUT,SCIN) ; patient lookup used by SC PATIENT LOOKUP rpc
  1. ; input:
  1. ; SCIN("VALUE") = value to lookup
  1. ; Lookup uses multiple index lookup of File #2
  1. ; output:
  1. ; SCOUT = location of data = ^TMP("DILIST",$J,i,0)
  1. ; for i=1:number of records returned:
  1. ; DFN^patient name^DOB^PID^DOD
  1. ; 1 2 3 4 5
  1. ;
  1. ;bp/cmf 205 original code next line
  1. ;D FIND^DIC(2,,".01;.03;.363;.09","MPS",SCIN("VALUE"),500)
  1. ;bp/cmf 205 change code next line
  1. ;oifo/swo 297 added .351 for DOD warning new functionality
  1. D FIND^DIC(2,,".01;.03;.363;.09;.351","PS",SCIN("VALUE"),300,"B^BS^BS5^SSN")
  1. I $G(DIERR) D CLEAN^DILF Q
  1. N SCOUNT S SCOUNT=+^TMP("DILIST",$J,0)
  1. N SC F SC=1:1:SCOUNT D
  1. . N NODE,SSN,DSSN,PLID
  1. . S NODE=^TMP("DILIST",$J,SC,0)
  1. . ;Apply DOB screen
  1. . S $P(NODE,U,3)=$$DOB^DPTLK1(+NODE)
  1. . ;Apply SSN screen
  1. . S SSN=$$SSN^DPTLK1(+NODE)
  1. . S DSSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,11)
  1. . S PLID=$P(NODE,U,4)
  1. . I $E(SSN,1,9)'?9N S (DSSN,PLID)=SSN
  1. . S $P(NODE,U,4)=$S($L(PLID)>5:PLID,1:DSSN)
  1. . ;Move screened data back into output global
  1. . ;oifo/swo 297 piece 6 is DOD field. Added for DOD warning
  1. . S ^TMP("DILIST",$J,SC,0)=$P(NODE,U,1,4)_U_$P(NODE,U,6)
  1. K ^TMP("DILIST",$J,0)
  1. K SCOUT S SCOUT="^TMP(""DILIST"","_$J_")"
  1. Q
  1. PSLST(SCDATA,SC) ;
  1. ;
  1. ; - Returns a array of positions that show the person currently
  1. ; assigned to the position, the preceptor for that position,
  1. ; for the patient is assigned to.
  1. ;
  1. ; Pass in the Patient's DFN
  1. ; To restrict to specific entries, pass in the following:
  1. ; Beginning and Ending Date Range
  1. ; A specific Team Position
  1. ; A Specific User entry (8930)
  1. ; A specific Team Purpose. (Read SCAPMC23 for how it exclude
  1. ; a specific team purpose.
  1. ; A specific role
  1. ; Flag whether to include patients associated by enrollement
  1. ;
  1. N SCDT,SCD,SCER1,SCDFN,SCPRP,SCPST,SCRLE,SCIND,SCUSR,SCTM,SCDTE
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE(.SC)
  1. S SCDTE=$G(SCDT("BEGIN"))
  1. ;
  1. S CNT=0
  1. K ^TMP($J,"PSLST")
  1. S SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCD","SCER1")
  1. S I=0 F S I=$O(SCD(I)) Q:'I D
  1. . I $D(SCTM) D
  1. .. Q:$P(SCD(I),U,3)'=SCTM
  1. .. S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
  1. . ;
  1. . I '$D(SCTM) D
  1. .. S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
  1. ;
  1. S CNT=0
  1. S I=""
  1. F S I=$O(^TMP($J,"PSLST",I)) Q:'I D
  1. . S:'$D(SCDTE) SCDTE=DT
  1. . S SCPIEN=$P($G(^TMP($J,"PSLST",I)),U,3)
  1. . S SCDATA(CNT)=^TMP($J,"PSLST",I)_U_$$PSMBR(SCPIEN,SCDTE)_U_+$P($G(^SCPT(404.43,$P($G(^TMP($J,"PSLST",I)),U,2),0)),U,5)_U_+$P($G(^SCTM(404.57,SCPIEN,0)),U,4)
  1. . S CNT=CNT+1
  1. K ^TMP($J,"PSLST")
  1. ;
  1. PSLTQ Q
  1. ;
  1. PSMBR(SCPIEN,SCPDT) ;
  1. ;
  1. N SCPRCP,SCMBR,SCPP
  1. ;
  1. S SCMBR=$$GETPRTP^SCAPMCU2(SCPIEN,SCPDT)
  1. S SCMBR=$S(+SCMBR>0:SCMBR,1:U)
  1. S SCPP=$$OKPREC2^SCMCLK(SCPIEN,SCPDT)
  1. S SCPRCP=$S(+SCPP>0:SCPP,1:U)
  1. Q SCMBR_U_SCPRCP
  1. ;
  1. VFILE(SCOK,SC) ;
  1. N SCFILE,SCIEN,SCFIELD,SCVAL,SCFDA,SCMSG
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. S SCOK=1
  1. D PARSE(.SC)
  1. S SCFDA(SCFILE,""_SCIEN_","_"",SCFIELD)=SCVAL
  1. ;
  1. D FILE^DIE("K","SCFDA","SCMSG")
  1. ;
  1. I $D(SCMSG("DIERR")) D
  1. . S SCOK=0
  1. Q
  1. ;
  1. SECKEY(SCOK,SCKEY) ;
  1. ;
  1. D CHK^SCUTBK
  1. ;
  1. S SCOK=$D(^XUSEC(SCKEY,DUZ))
  1. Q
  1. ;
  1. PSALST(SCDATA,SC) ;
  1. ;
  1. ; - Returns a array of positions that show the person currently
  1. ; assigned to the position, the preceptor for that position,
  1. ; for the patient is assigned to.
  1. ;
  1. ; Pass in the Patient's DFN
  1. ; To restrict to specific entries, pass in the following:
  1. ; Beginning and Ending Date Range
  1. ; A specific Team Position
  1. ; A Specific User entry (8930)
  1. ; A specific Team Purpose. (Read SCAPMC23 for how it exclude
  1. ; a specific team purpose.
  1. ; A specific role
  1. ; Flag whether to include patients associated by enrollement
  1. ;
  1. N SCDT,SCD,SCER1,SCDFN,SCPRP,SCPST,SCRLE,SCIND,SCUSR,SCTM,SCDTE,SCPTTMA
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE(.SC)
  1. S SCPTTMA=$G(SC("TEAMASSIGN")) ;NEW JLU
  1. S SCDTE=$G(SCDT("BEGIN"),DT) ;bp/cmf 177 added DT for gui
  1. ;
  1. S CNT=0
  1. K ^TMP($J,"PSLST")
  1. S SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCD","SCER1")
  1. S I=0 F S I=$O(SCD(I)) Q:'I D
  1. .Q:$P(SCD(I),U,11)'=SCPTTMA
  1. .S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
  1. ;
  1. S CNT=0
  1. S I=""
  1. F S I=$O(^TMP($J,"PSLST",I)) Q:'I D
  1. . S:'$D(SCDTE) SCDTE=DT
  1. . S SCPIEN=$P($G(^TMP($J,"PSLST",I)),U,3)
  1. . S SCDATA(CNT)=^TMP($J,"PSLST",I)_U_$$PSMBR(SCPIEN,SCDTE)_U_+$P($G(^SCPT(404.43,$P($G(^TMP($J,"PSLST",I)),U,2),0)),U,5)_U_+$P($G(^SCTM(404.57,SCPIEN,0)),U,4)
  1. . S CNT=CNT+1
  1. K ^TMP($J,"PSLST")
  1. ;
  1. PSALSTQ Q