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

ORRCTIU.m

Go to the documentation of this file. 
  1. ORRCTIU ; SLC/JER - TIU data for CM ; 7/18/05 10:38
  1.  ;;1.0;CARE MANAGEMENT;**2**;Jul 15, 2003
  1.  ;
  1.  ; This routine invokes IAs: 2322,2323,2834,2937,2944,2960,4175,4733
  1.  ;
  1. GETPTUNS(ORRCY,AUDUZ) ; Get pts w/documents that need user's signature
  1.  ; Returns @ORRCY@(DFN,"DOC:"_TIUDA)=""
  1.  ; [from ORRCDPT]
  1.  N TITLE,GVN,ORT,TIUDA,ORDFN,ITR,ORRCASIG
  1.  S TITLE=0,GVN=$NA(^TIU(8925,"AAU")),ORRCY=$NA(^TMP($J,"ORRCTIU")) K @ORRCY
  1.  F  S TITLE=$O(@GVN@(AUDUZ,TITLE)) Q:+TITLE'>0  D
  1.  . S ORT=0 F  S ORT=$O(@GVN@(AUDUZ,TITLE,5,ORT)) Q:+ORT'>0  D
  1.  .. S TIUDA=0
  1.  .. F  S TIUDA=$O(@GVN@(AUDUZ,TITLE,5,ORT,TIUDA)) Q:+TIUDA'>0  D
  1.  ... S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
  1.  ... I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q  ;not on list
  1.  ... I '+$$CANDO^TIULP(TIUDA,"SIGNATURE",AUDUZ) Q  ; user may not sign
  1.  ... S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
  1.  S TITLE=0,GVN=$NA(^TIU(8925,"ASUP"))
  1.  F  S TITLE=$O(@GVN@(AUDUZ,TITLE)) Q:+TITLE'>0  D
  1.  . N STATUS F STATUS=5,6 D
  1.  .. S ORT=0 F  S ORT=$O(@GVN@(AUDUZ,TITLE,STATUS,ORT)) Q:+ORT'>0  D
  1.  ... S TIUDA=0
  1.  ... F  S TIUDA=$O(@GVN@(AUDUZ,TITLE,STATUS,ORT,TIUDA)) Q:+TIUDA'>0  D
  1.  .... S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
  1.  .... I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q  ;not on list
  1.  .... I '+$$CANDO^TIULP(TIUDA,$S(STATUS=5:"SIGNATURE",1:"COSIGNATURE"),AUDUZ) Q  ; user may not Sign/Cosign
  1.  .... S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
  1.  ; capture addl signer docs 
  1.  K ^TMP("TIUSIGN",$J),^TMP("ORRCASIG",$J)
  1.  S ORRCASIG="",ITR=0
  1.  D NEEDSIG^TIULX(.ORRCASIG,AUDUZ)
  1.  Q:'$D(@ORRCASIG)
  1.  M ^TMP("ORRCASIG",$J)=@ORRCASIG
  1.  F  S ITR=$O(^TMP("ORRCASIG",$J,ITR)) Q:'ITR  D
  1.  . S TIUDA=^TMP("ORRCASIG",$J,ITR)
  1.  . S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
  1.  . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q  ;not on list?
  1.  . I '+$$CANDO^TIULP(TIUDA,"SIGNATURE",AUDUZ) Q  ; user may not sign
  1.  . S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
  1.  K ^TMP("TIUSIGN",$J),^TMP("ORRCASIG",$J)
  1.  Q
  1.  ;
  1. LISTUNS(ORY,ORUSR,ORPAT) ; -- Get list of unsigned documents for ORPAT by ORUSR
  1.  ; 
  1.  Q
  1.  ;
  1. TEXT(ORY,DOC) ; -- Return text of DOCs in
  1.  ; @ORY@(#) = Item=ID^Title^Date IN HL7 format
  1.  ;          = Text=line of document text
  1.  N ORN,ORI,ORRCY,TIUDA,TIUY,TIUI,TIUX
  1.  S ORN=0,ORY=$NA(^TMP($J,"ORRCDOC")) K @ORY
  1.  S ORI="" F  S ORI=$O(DOC(ORI)) Q:ORI=""  D
  1.  . S TIUDA=+$P(DOC(ORI),":",2) D TGET^TIUSRVR1(.ORRCY,TIUDA)
  1.  . M TIUY=ORRCY
  1.  . S TIUX=$$RESOLVE^TIUSRVLO(TIUDA)
  1.  . S ORN=ORN+1,@ORY@(ORN)="Item=DOC:"_TIUDA_U_$P(TIUX,U)_U_$P($$FMTHL7^XLFDT($P(TIUX,U,2)),"-")_U_$$REQENC(TIUDA)
  1.  . S TIUI=0 F  S TIUI=$O(@TIUY@(TIUI)) Q:TIUI<1  S ORN=ORN+1,@ORY@(ORN)="Text="_@TIUY@(TIUI)
  1.  Q
  1.  ;
  1. REQENC(TIUDA)   ; -- Determine whether encounter data is needed
  1.  N ORRD0,ORRD12,ORSVC,ORRY,ORRDP,ORRCSA,ORASK,ORRPRIMD,DATANEED,ORROPT,LST,ORRPRIME,ORRCLST,ORRCDP,ORRCASK
  1.  S ORRD0=$G(^TIU(8925,TIUDA,0)),ORRD12=$G(^(12)),ORRY="false"
  1.  S (ORROPT,DATANEED)=0
  1.  ; Load existing encounter info
  1.  D PCE4NOTE^ORWPCE3(.ORRCLST,TIUDA,+$P(ORRD0,U,2))
  1.  ; identify primary provider
  1.  S ORRPRIMD=$$GETPRIMD(TIUDA,ORRD12,.ORRCLST)
  1.  M LST=ORRCLST
  1.  ; determine whether "Data Needed"
  1.  ; 1. if encdt > today quit false
  1.  I +$P(ORRD0,U,7)>(DT_".235959") G CHKASK
  1.  ; 2. if service category '= "A", "I", or "T" quit false
  1.  S ORSVC=$P(ORRD0,U,13)
  1.  I '$S(ORSVC="A":1,ORSVC="I":1,ORSVC="T":1,1:0) G CHKASK
  1.  S ORROPT=1
  1.  ; if TIU doc param SUPPRESS DX/CPT ON ENTRY is true, quit false
  1.  D DOCPRM^TIULC1(+ORRD0,.ORRCDP)
  1.  M ORRDP=ORRCDP
  1.  I +$P(ORRDP(0),U,14) G CHKASK
  1.  ; if stand-alone visit, quit true
  1.  D HASVISIT^ORWPCE(.ORRCSA,TIUDA,+$P(ORRD0,U,2),+$P(ORRD12,U,11),+$P(ORRD0,U,7))
  1.  I ORRCSA<1 S DATANEED=1 G CHKASK
  1.  ; if TIU doc param ASK DX/CPT ON ALL OPT VISITS is true, quit true
  1.  I +$P(ORRDP(0),U,16) S DATANEED=1 G CHKASK
  1. CHKASK I +DATANEED S DATANEED=$$CHKPCE(TIUDA,.ORRCLST,$P(ORRD0,U,2),$P(ORRD12,U,11))
  1.  M LST=ORRCLST
  1.  D ASKPCE^ORWPCE2(.ORRCASK,DUZ,+$P(ORRD12,U,11))
  1.  M ORASK=ORRCASK
  1.  ; if Never or Disable, quit false
  1.  I $S(ORASK=6:1,ORASK=7:1,1:0) S ORRY="false" G REQENCX
  1.  ; if Always, quit true
  1.  I ORASK=5 S ORRY="true" G REQENCX
  1.  ; if Data Needed, quit true
  1.  I ORASK=3,+DATANEED S ORRY="true" G REQENCX
  1.  ; if Outpatient, quit true
  1.  I ORASK=4,+ORROPT S ORRY="true" G REQENCX
  1.  ; If we don't know who the primary encounter provider is, and we need to know, we
  1.  ; must go to the chart to sign the note - so we treat it the same as if they are primary
  1.  I ORRPRIMD=0 S ORRPRIME=1
  1.  E  S ORRPRIME=+(DUZ=ORRPRIMD)
  1.  ; if Primary/Data Needed, quit true
  1.  I ORASK=0,ORRPRIME,+DATANEED S ORRY="true" G REQENCX
  1.  ; if Primary/Outpatient, quit true
  1.  I ORASK=1,ORRPRIME,+ORROPT S ORRY="true" G REQENCX
  1.  ; if Primary Always, quit true
  1.  I ORASK=2,ORRPRIME S ORRY="true" G REQENCX
  1. REQENCX Q ORRY
  1.  ;
  1. CHKPCE(TIUDA,LST,PTNT,LOC)    ; Look for existing PCE data
  1.  N ENCDT,ORI,CPT,COUNT,MAX,ICD,CODE,SUB,EXPNEED,EXP,RESULT,SCREQ,DOCPARM
  1.  N ORRCSREQ,ORRCDOCP
  1.  S (CPT,ICD,ORI,EXPNEED,EXP,RESULT,COUNT)=0
  1.  S MAX=2
  1.  S ENCDT=$P($P(LST(1),U,4),";",2)
  1.  D SCSEL^ORWPCE(.ORRCSREQ,PTNT,ENCDT,LOC,"")
  1.  M SCREQ=ORRCSREQ
  1.  D DOCPARM^TIUSRVP1(.ORRCDOCP,TIUDA,0)
  1.  M DOCPARM=ORRCDOCP
  1.  I +$P(DOCPARM(0),U,15)=1 S EXPNEED=1,MAX=8
  1.  F  S ORI=$O(LST(ORI)) Q:+ORI'>0  D  Q:(COUNT'<MAX)
  1.  . S CODE=$P(LST(ORI),U)
  1.  . I CODE="POV",'ICD S ICD=1,COUNT=COUNT+1
  1.  . I CODE="CPT",'CPT S CPT=1,COUNT=COUNT+1
  1.  . I EXPNEED,CODE="VST" D
  1.  . . N VAL,IDX
  1.  . . S SUB=$P(LST(ORI),U,2),VAL=$P(LST(ORI),U,3)
  1.  . . S IDX=$S(SUB="SC":1,SUB="AO":2,SUB="IR":3,SUB="EC":4,SUB="MST":5,SUB="HNC":6,1:0)
  1.  . . I IDX>0 S COUNT=COUNT+1 I VAL'="" S $P(SCREQ,";",IDX)=0
  1.  I 'ICD Q 1
  1.  I 'CPT Q 1
  1.  F ORI=1:1:6 D  Q:RESULT=1
  1.  . I $P($P(SCREQ,";",ORI),U,1) S RESULT=1
  1.  Q RESULT
  1. GETPRIMD(TIUDA,ORRD12,LST)    ; Get the Primary Provider
  1.  N ORRY,ORI,ORMDEF,TIUSPRM,ORRCSPRM
  1.  S (ORI,ORRY)=0
  1.  D SITEPARM^TIUSRVP1(.ORRCSPRM) M TIUSPRM=ORRCSPRM
  1.  ; 1. Check for the provider in the encounter, if it exists.
  1.  F  S ORI=$O(LST(ORI)) Q:+ORI'>0  D  Q:+ORRY
  1.  . I $P(LST(ORI),U)="PRV",+$P(LST(ORI),U,6) S ORRY=$P(LST(ORI),U,2)
  1.  ; 2. check for the default primary as specified in TIU
  1.  I 'ORRY D  ;DEFDOC^TIUSRVP1(.ORMDEF,$P(ORRD12,U,11),DUZ,$P(ORRD0,U,7),TIUDA) S ORRY=+ORMDEF
  1.  . I +$P(TIUSPRM,U,8)=1 S ORRY=$$DFLTDOC^TIUPXAPI($P(ORRD12,U,11)) I +ORRY'=DUZ S ORRY=0
  1.  Q ORRY
  1. SIGN(ORY,LIST) ; -- Apply signature to documents in LIST(#)=DOC:##
  1.  ; RPC = ORRC UNSIGNED DOCS SIGN
  1.  Q