VPRDJ08 ;SLC/MKB -- Documents ;6/25/12 16:11
;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; ^TIU(8925.1 2321,5677
; ^TIU(8926.1 5678
; ^VA(200 10060
; DIQ 2056
; RAO7PC1 2043
; TIUCNSLT 5546
; TIUCP 3568
; TIULQ 2693
; TIULX 3058
; TIUSROI 5676
; TIUSRVLO 2834,2865
; XLFSTR 10104
;
; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
;
TIU1(ID) ; -- document
I ID[";" D Q
. I ID D EN1($$CP1^VPRDJ08A(DFN,ID),"CP") Q ;CP
. D EN1($$LR1^VPRDJ08A(DFN,ID),"LR") Q ;Lab
I ID["-" D Q ;Radiology
. S (BEG,END)=9999999.9999-+ID D EN1^RAO7PC1(DFN,BEG,END,"99P")
. Q:'$D(^TMP($J,"RAE1",DFN,ID)) ;deleted
. D EN1($$RA1^VPRDJ08A(DFN,ID),"RA") K ^TMP($J,"RAE1")
D EN1(ID,38)
Q
;
EN1(VPRX,TIU) ; -- document
; Expects DFN, VPRX=IEN^$$RESOLVE^TIUSRVLO(IEN) or equivalent
; TIU = document class#, or code (CP, RA, LR) if non-TIU
N DOC,IEN,X,VPRTIU,ES,I,TEXT,SUB,VPRY,ERR
S IEN=$P($G(VPRX),U),TIU=$G(TIU) Q:IEN="" ;invalid ien
;
I +VPRX=VPRX,TIU D ;get TIU data string, if needed
. N SHOWADD,DA S SHOWADD=1,DA=+VPRX
. S VPRX=DA_U_$$RESOLVE^TIUSRVLO(DA)
Q:"UNKNOWN"[$P($G(VPRX),U,2) ;null or invalid
S DOC("localId")=IEN,DOC("uid")=$$SETUID^VPRUTILS("document",DFN,IEN)
S DOC("localTitle")=$P(VPRX,U,2)
S DOC("referenceDateTime")=$$JSONDT^VPRUTILS($P(VPRX,U,3))
S X=$P(VPRX,U,6) D ;S:$L(X) DOC("location")=X
. N LOC,FAC S LOC=$S($L(X):+$O(^SC("B",X,0)),1:0)
. S X=$$FAC^VPRD(LOC)
. S DOC("facilityCode")=$P(X,U),DOC("facilityName")=$P(X,U,2)
S X=$P(VPRX,U,7) S:$L(X) DOC("statusName")=X
S:$P(VPRX,U,11) DOC("images")=+$P(VPRX,U,11)
S:$L($P(VPRX,U,12)) DOC("subject")=$P(VPRX,U,12)
I $P(VPRX,U,14)>5 S DOC("parent")=$P(VPRX,U,14) ;ID notes
A ; national title
S X=$S(TIU:$$GET1^DIQ(8925,IEN_",",".01:1501","I"),1:$P(VPRX,U,10))
I X D ;National Title + attributes
. N IENS,TIU,Y,FNUM,NAME
. S IENS=X_"," D GETS^DIQ(8926.1,IENS,"*","IE","TIU")
. S DOC("nationalTitle","vuid")="urn:va:vuid:"_$G(TIU(8926.1,IENS,99.99,"E"))
. S DOC("nationalTitle","title")=$G(TIU(8926.1,IENS,.01,"E"))
. F I=".04^Subject^2",".05^Role^3",".06^Setting^4",".07^Service^5",".08^Type^6" D
.. S Y=+$G(TIU(8926.1,IENS,+I,"I")) Q:Y'>0
.. S FNUM="8926."_+$P(I,U,3),NAME=$$LOW^XLFSTR($P(I,U,2))
.. S DOC("nationalTitle"_$P(I,U,2),"vuid")="urn:va:vuid:"_$$VUID^VPRD(Y,FNUM)
.. S DOC("nationalTitle"_$P(I,U,2),NAME)=$G(TIU(8926.1,IENS,+I,"E"))
B ; other TIU data
D:TIU EXTRACT^TIULQ(IEN,"VPRTIU",,".01:.05;.09;1201;1202;1208;1209;1301;1501:1508",,1,,1) ;".01:.04;1501:1508")
S X=$G(VPRTIU(IEN,1201,"I")) S:X DOC("entered")=$$JSONDT^VPRUTILS(X)
S X=$G(VPRTIU(IEN,.09,"E")) S:$L(X) DOC("urgency")=X
S X=TIU I TIU S X=+$G(VPRTIU(IEN,.01,"I")),X=$$CATG^VPRDTIU(X) ;2U type code
S DOC("documentTypeCode")=X,DOC("documentTypeName")=$$TYPE(X)
S DOC("documentClass")=$S(X="LR":"LR LABORATORY REPORTS",X="SR":"SURGICAL REPORTS",X="CP":"CLINICAL PROCEDURES",X="RA":"RADIOLOGY REPORTS",X="DS":"DISCHARGE SUMMARY",1:"PROGRESS NOTES")
S X=$S(TIU:$G(VPRTIU(IEN,.03,"I")),1:$P(VPRX,U,8))
S:X DOC("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,X),DOC("encounterName")=$$NAME^VPRDJ04(X)
C ; text blocks, signatures
N VPRT,VPRA,VPRADD
S DOC("text",1,"dateTime")=DOC("referenceDateTime")
S DOC("text",1,"status")=$G(DOC("statusName"))
S DOC("text",1,"uid")=DOC("uid")
S VPRT=1,X=$P(VPRX,U,5),I=0
I X D USER(.I,+X,$P(X,";",3),"A") ;author
M ES=VPRTIU(IEN) S X=$P(VPRX,"//",2) ;non-TIU, put into ES for use:
I $L(X) S ES(1502,"I")=+X,ES(1502,"E")=$P(X,";",2),ES(1501,"I")=$P(X,";",3)
I $G(ES(1501,"I")) D USER(.I,ES(1502,"I"),ES(1502,"E"),"S",ES(1501,"I")) ;signer
I $G(ES(1507,"I")) D USER(.I,ES(1508,"I"),ES(1508,"E"),"C",ES(1507,"I")) ;cosigner
I $G(ES(1208,"I")) D USER(.I,ES(1208,"I"),ES(1208,"E"),"X") ;expected cosigner
S X=+$G(ES(1209,"I")) I X D
. S DOC("attendingUid")=$$SETUID^VPRUTILS("user",,X)
. S DOC("attendingName")=$P($G(^VA(200,X,0)),U)
I $G(VPRTEXT) D
. S X=$S(TIU:$NA(VPRTIU(IEN,"TEXT")),1:$NA(^TMP("VPRTEXT",$J,IEN)))
. K ^TMP($J,"VPR TIU TEXT")
. D SETTEXT^VPRUTILS(X,$NA(^TMP($J,"VPR TIU TEXT")))
. M DOC("text",1,"content","\")=^TMP($J,"VPR TIU TEXT")
D ; addenda
S VPRA=0 F S VPRA=$O(VPRTIU(IEN,"ZADD",VPRA)) Q:VPRA<1 D
. S VPRT=VPRT+1,I=0 K VPRADD M VPRADD=VPRTIU(IEN,"ZADD",VPRA)
. S DOC("text",VPRT,"status")=$G(VPRADD(.05,"E"))
. S DOC("text",VPRT,"uid")=$$SETUID^VPRUTILS("document",DFN,VPRA)
. S DOC("text",VPRT,"dateTime")=$$JSONDT^VPRUTILS($G(VPRADD(1301,"I")))
. I $G(VPRADD(1202,"I")) D USER(.I,VPRADD(1202,"I"),VPRADD(1202,"E"),"A")
. I $G(VPRADD(1501,"I")) D USER(.I,VPRADD(1502,"I"),VPRADD(1502,"E"),"S",VPRADD(1501,"I"))
. I $G(VPRADD(1507,"I")) D USER(.I,VPRADD(1508,"I"),VPRADD(1508,"E"),"C",VPRADD(1507,"I"))
. Q:'$G(VPRTEXT) K ^TMP($J,"VPR TIU TEXT")
. S X=$NA(VPRTIU(IEN,"ZADD",VPRA,"TEXT"))
. D SETTEXT^VPRUTILS(X,$NA(^TMP($J,"VPR TIU TEXT")))
. M DOC("text",VPRT,"content","\")=^TMP($J,"VPR TIU TEXT")
ENQ ; end
K ^TMP($J,"VPR TIU TEXT")
D ADD^VPRDJ("DOC","document")
Q
;
USER(N,IEN,NAME,ROLE,DATE) ; -- set author, signer(s)
Q:'$G(IEN) S N=+$G(N)+1
S DOC("text",VPRT,"clinicians",N,"uid")=$$SETUID^VPRUTILS("user",,IEN)
S DOC("text",VPRT,"clinicians",N,"name")=$S($L($G(NAME)):NAME,1:$P($G(^VA(200,IEN,0)),U))
S DOC("text",VPRT,"clinicians",N,"role")=$G(ROLE)
Q:'$G(DATE) ;not co/signed
S DOC("text",VPRT,"clinicians",N,"signedDateTime")=$$JSONDT^VPRUTILS(DATE)
S DOC("text",VPRT,"clinicians",N,"signature")=$$SIG^VPRDTIU(IEN)
Q
;
; ------------ Get/apply search criteria ------------
; [from DOCUMENT^VPRDJ0]
;
SETUP ; -- convert FILTER("attribute") = value to TIU criteria
; Expects: FILTER("category") = code (see $$CATG)
; FILTER("status") = 'signed','unsigned','all'
; Returns: CLASS,[SUBCLASS,STATUS]
;
N TYPE,STS,CP
S TYPE=$$UP^XLFSTR($G(FILTER("category")))
S CLASS=0,(SUBCLASS,STATUS)=""
;
; status [default='signed']
S STS=$$LOW^XLFSTR($G(FILTER("status")))
S STATUS=$S(STS?1"unsig".E:2,STS="all":"5^2",1:5) ;TIUSRVLO statuses
;
; all documents
S:TYPE="" TYPE="ALL"
I TYPE="ALL" S CLASS="3^244^"_+$$CLASS^TIUSROI("SURGICAL REPORTS")_"^CP^LR^RA" Q
;
I TYPE="PN" S CLASS=3 Q ;Progress Notes
I TYPE="CR" S CLASS=3,SUBCLASS=$$CLASS^TIUCNSLT Q ;Consults
I TYPE="CWAD" S CLASS=3,SUBCLASS="25^27^30^31" Q ;CWAD
I TYPE="C" S CLASS=3,SUBCLASS=30 Q ;Crisis Note
I TYPE="W" S CLASS=3,SUBCLASS=31 Q ;Clinical Warning
I TYPE="A" S CLASS=3,SUBCLASS=25 Q ;Allergy Note
I TYPE="D" S CLASS=3,SUBCLASS=27 Q ;Advance Directive
;
I TYPE="DS" S CLASS=244 Q ;Discharge Summary
;
I TYPE="SR" S CLASS=$$CLASS^TIUSROI("SURGICAL REPORTS") Q
I TYPE="CP" D Q ;Clin Procedures
. I STATUS'=2 S CLASS="CP" ; if unsigned,
. E D CPCLASS^TIUCP(.CP) S CLASS=CP ; use TIU class#
;
I TYPE="LR" S CLASS=$S(STATUS=2:$$LR,1:"LR") Q ;Lab/Pathology
;
I TYPE="RA" S CLASS="RA" Q ;Radiology
;
Q
;
LR() ; -- Return ien of Lab class
N Y S Y=+$O(^TIU(8925.1,"B","LR LABORATORY REPORTS",0))
I Y>0,$S($P($G(^TIU(8925.1,Y,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S Y=0
Q Y
;
MATCH(DOC,STS) ; -- Return 1 or 0, if document DA matches search criteria
N Y,DA,LOCAL,NATL,X0,OK S Y=0
S DA=+$G(DOC) G:DA<1 MQ
; include addenda if pulling only unsigned items
I $P(DOC,U,2)?1"Addendum ".E,STATUS'=2 G MQ
; TIU unsigned list can include completed parent notes
I $G(STS)=2,$P(DOC,U,7)'="unsigned" G MQ
S LOCAL=$$GET1^DIQ(8925,DA_",",.01,"I") ;local Title 8925.1 ien
I $L(SUBCLASS) D G:'OK MQ
. N I,X S OK=0
. F I=1:1:$L(SUBCLASS,"^") S X=$P(SUBCLASS,U,I) I $$ISA^TIULX(LOCAL,X) S OK=1 Q
S Y=1
MQ Q Y
;
TYPE(X) ; -- Return name of category type X
S X=$G(X)
I X="PN" Q "Progress Note"
I X="DS" Q "Discharge Summary"
I X="CP" Q "Clinical Procedure"
I X="SR" Q "Surgery Report"
I X="LR" Q "Laboratory Report"
I X="RA" Q "Radiology Report"
I X="CR" Q "Consult Report"
I X="C" Q "Crisis Note"
I X="W" Q "Clinical Warning"
I X="A" Q "Allergy/Adverse Reaction"
I X="D" Q "Advance Directive"
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ08 8919 printed Apr 09, 2024@21:47:33 Page 2
VPRDJ08 ;SLC/MKB -- Documents ;6/25/12 16:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^SC 10040
+7 ; ^TIU(8925.1 2321,5677
+8 ; ^TIU(8926.1 5678
+9 ; ^VA(200 10060
+10 ; DIQ 2056
+11 ; RAO7PC1 2043
+12 ; TIUCNSLT 5546
+13 ; TIUCP 3568
+14 ; TIULQ 2693
+15 ; TIULX 3058
+16 ; TIUSROI 5676
+17 ; TIUSRVLO 2834,2865
+18 ; XLFSTR 10104
+19 ;
+20 ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+21 ;
TIU1(ID) ; -- document
+1 IF ID[";"
Begin DoDot:1
+2 ;CP
IF ID
DO EN1($$CP1^VPRDJ08A(DFN,ID),"CP")
QUIT
+3 ;Lab
DO EN1($$LR1^VPRDJ08A(DFN,ID),"LR")
QUIT
End DoDot:1
QUIT
+4 ;Radiology
IF ID["-"
Begin DoDot:1
+5 SET (BEG,END)=9999999.9999-+ID
DO EN1^RAO7PC1(DFN,BEG,END,"99P")
+6 ;deleted
if '$DATA(^TMP($JOB,"RAE1",DFN,ID))
QUIT
+7 DO EN1($$RA1^VPRDJ08A(DFN,ID),"RA")
KILL ^TMP($JOB,"RAE1")
End DoDot:1
QUIT
+8 DO EN1(ID,38)
+9 QUIT
+10 ;
EN1(VPRX,TIU) ; -- document
+1 ; Expects DFN, VPRX=IEN^$$RESOLVE^TIUSRVLO(IEN) or equivalent
+2 ; TIU = document class#, or code (CP, RA, LR) if non-TIU
+3 NEW DOC,IEN,X,VPRTIU,ES,I,TEXT,SUB,VPRY,ERR
+4 ;invalid ien
SET IEN=$PIECE($GET(VPRX),U)
SET TIU=$GET(TIU)
if IEN=""
QUIT
+5 ;
+6 ;get TIU data string, if needed
IF +VPRX=VPRX
IF TIU
Begin DoDot:1
+7 NEW SHOWADD,DA
SET SHOWADD=1
SET DA=+VPRX
+8 SET VPRX=DA_U_$$RESOLVE^TIUSRVLO(DA)
End DoDot:1
+9 ;null or invalid
if "UNKNOWN"[$PIECE($GET(VPRX),U,2)
QUIT
+10 SET DOC("localId")=IEN
SET DOC("uid")=$$SETUID^VPRUTILS("document",DFN,IEN)
+11 SET DOC("localTitle")=$PIECE(VPRX,U,2)
+12 SET DOC("referenceDateTime")=$$JSONDT^VPRUTILS($PIECE(VPRX,U,3))
+13 ;S:$L(X) DOC("location")=X
SET X=$PIECE(VPRX,U,6)
Begin DoDot:1
+14 NEW LOC,FAC
SET LOC=$SELECT($LENGTH(X):+$ORDER(^SC("B",X,0)),1:0)
+15 SET X=$$FAC^VPRD(LOC)
+16 SET DOC("facilityCode")=$PIECE(X,U)
SET DOC("facilityName")=$PIECE(X,U,2)
End DoDot:1
+17 SET X=$PIECE(VPRX,U,7)
if $LENGTH(X)
SET DOC("statusName")=X
+18 if $PIECE(VPRX,U,11)
SET DOC("images")=+$PIECE(VPRX,U,11)
+19 if $LENGTH($PIECE(VPRX,U,12))
SET DOC("subject")=$PIECE(VPRX,U,12)
+20 ;ID notes
IF $PIECE(VPRX,U,14)>5
SET DOC("parent")=$PIECE(VPRX,U,14)
A ; national title
+1 SET X=$SELECT(TIU:$$GET1^DIQ(8925,IEN_",",".01:1501","I"),1:$PIECE(VPRX,U,10))
+2 ;National Title + attributes
IF X
Begin DoDot:1
+3 NEW IENS,TIU,Y,FNUM,NAME
+4 SET IENS=X_","
DO GETS^DIQ(8926.1,IENS,"*","IE","TIU")
+5 SET DOC("nationalTitle","vuid")="urn:va:vuid:"_$GET(TIU(8926.1,IENS,99.99,"E"))
+6 SET DOC("nationalTitle","title")=$GET(TIU(8926.1,IENS,.01,"E"))
+7 FOR I=".04^Subject^2",".05^Role^3",".06^Setting^4",".07^Service^5",".08^Type^6"
Begin DoDot:2
+8 SET Y=+$GET(TIU(8926.1,IENS,+I,"I"))
if Y'>0
QUIT
+9 SET FNUM="8926."_+$PIECE(I,U,3)
SET NAME=$$LOW^XLFSTR($PIECE(I,U,2))
+10 SET DOC("nationalTitle"_$PIECE(I,U,2),"vuid")="urn:va:vuid:"_$$VUID^VPRD(Y,FNUM)
+11 SET DOC("nationalTitle"_$PIECE(I,U,2),NAME)=$GET(TIU(8926.1,IENS,+I,"E"))
End DoDot:2
End DoDot:1
B ; other TIU data
+1 ;".01:.04;1501:1508")
if TIU
DO EXTRACT^TIULQ(IEN,"VPRTIU",,".01:.05;.09;1201;1202;1208;1209;1301;1501:1508",,1,,1)
+2 SET X=$GET(VPRTIU(IEN,1201,"I"))
if X
SET DOC("entered")=$$JSONDT^VPRUTILS(X)
+3 SET X=$GET(VPRTIU(IEN,.09,"E"))
if $LENGTH(X)
SET DOC("urgency")=X
+4 ;2U type code
SET X=TIU
IF TIU
SET X=+$GET(VPRTIU(IEN,.01,"I"))
SET X=$$CATG^VPRDTIU(X)
+5 SET DOC("documentTypeCode")=X
SET DOC("documentTypeName")=$$TYPE(X)
+6 SET DOC("documentClass")=$SELECT(X="LR":"LR LABORATORY REPORTS",X="SR":"SURGICAL REPORTS",X="CP":"CLINICAL PROCEDURES",X="RA":"RADIOLOGY REPORTS",X="DS":"DISCHARGE SUMMARY",1:"PROGRESS NOTES")
+7 SET X=$SELECT(TIU:$GET(VPRTIU(IEN,.03,"I")),1:$PIECE(VPRX,U,8))
+8 if X
SET DOC("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,X)
SET DOC("encounterName")=$$NAME^VPRDJ04(X)
C ; text blocks, signatures
+1 NEW VPRT,VPRA,VPRADD
+2 SET DOC("text",1,"dateTime")=DOC("referenceDateTime")
+3 SET DOC("text",1,"status")=$GET(DOC("statusName"))
+4 SET DOC("text",1,"uid")=DOC("uid")
+5 SET VPRT=1
SET X=$PIECE(VPRX,U,5)
SET I=0
+6 ;author
IF X
DO USER(.I,+X,$PIECE(X,";",3),"A")
+7 ;non-TIU, put into ES for use:
MERGE ES=VPRTIU(IEN)
SET X=$PIECE(VPRX,"//",2)
+8 IF $LENGTH(X)
SET ES(1502,"I")=+X
SET ES(1502,"E")=$PIECE(X,";",2)
SET ES(1501,"I")=$PIECE(X,";",3)
+9 ;signer
IF $GET(ES(1501,"I"))
DO USER(.I,ES(1502,"I"),ES(1502,"E"),"S",ES(1501,"I"))
+10 ;cosigner
IF $GET(ES(1507,"I"))
DO USER(.I,ES(1508,"I"),ES(1508,"E"),"C",ES(1507,"I"))
+11 ;expected cosigner
IF $GET(ES(1208,"I"))
DO USER(.I,ES(1208,"I"),ES(1208,"E"),"X")
+12 SET X=+$GET(ES(1209,"I"))
IF X
Begin DoDot:1
+13 SET DOC("attendingUid")=$$SETUID^VPRUTILS("user",,X)
+14 SET DOC("attendingName")=$PIECE($GET(^VA(200,X,0)),U)
End DoDot:1
+15 IF $GET(VPRTEXT)
Begin DoDot:1
+16 SET X=$SELECT(TIU:$NAME(VPRTIU(IEN,"TEXT")),1:$NAME(^TMP("VPRTEXT",$JOB,IEN)))
+17 KILL ^TMP($JOB,"VPR TIU TEXT")
+18 DO SETTEXT^VPRUTILS(X,$NAME(^TMP($JOB,"VPR TIU TEXT")))
+19 MERGE DOC("text",1,"content","\")=^TMP($JOB,"VPR TIU TEXT")
End DoDot:1
D ; addenda
+1 SET VPRA=0
FOR
SET VPRA=$ORDER(VPRTIU(IEN,"ZADD",VPRA))
if VPRA<1
QUIT
Begin DoDot:1
+2 SET VPRT=VPRT+1
SET I=0
KILL VPRADD
MERGE VPRADD=VPRTIU(IEN,"ZADD",VPRA)
+3 SET DOC("text",VPRT,"status")=$GET(VPRADD(.05,"E"))
+4 SET DOC("text",VPRT,"uid")=$$SETUID^VPRUTILS("document",DFN,VPRA)
+5 SET DOC("text",VPRT,"dateTime")=$$JSONDT^VPRUTILS($GET(VPRADD(1301,"I")))
+6 IF $GET(VPRADD(1202,"I"))
DO USER(.I,VPRADD(1202,"I"),VPRADD(1202,"E"),"A")
+7 IF $GET(VPRADD(1501,"I"))
DO USER(.I,VPRADD(1502,"I"),VPRADD(1502,"E"),"S",VPRADD(1501,"I"))
+8 IF $GET(VPRADD(1507,"I"))
DO USER(.I,VPRADD(1508,"I"),VPRADD(1508,"E"),"C",VPRADD(1507,"I"))
+9 if '$GET(VPRTEXT)
QUIT
KILL ^TMP($JOB,"VPR TIU TEXT")
+10 SET X=$NAME(VPRTIU(IEN,"ZADD",VPRA,"TEXT"))
+11 DO SETTEXT^VPRUTILS(X,$NAME(^TMP($JOB,"VPR TIU TEXT")))
+12 MERGE DOC("text",VPRT,"content","\")=^TMP($JOB,"VPR TIU TEXT")
End DoDot:1
ENQ ; end
+1 KILL ^TMP($JOB,"VPR TIU TEXT")
+2 DO ADD^VPRDJ("DOC","document")
+3 QUIT
+4 ;
USER(N,IEN,NAME,ROLE,DATE) ; -- set author, signer(s)
+1 if '$GET(IEN)
QUIT
SET N=+$GET(N)+1
+2 SET DOC("text",VPRT,"clinicians",N,"uid")=$$SETUID^VPRUTILS("user",,IEN)
+3 SET DOC("text",VPRT,"clinicians",N,"name")=$SELECT($LENGTH($GET(NAME)):NAME,1:$PIECE($GET(^VA(200,IEN,0)),U))
+4 SET DOC("text",VPRT,"clinicians",N,"role")=$GET(ROLE)
+5 ;not co/signed
if '$GET(DATE)
QUIT
+6 SET DOC("text",VPRT,"clinicians",N,"signedDateTime")=$$JSONDT^VPRUTILS(DATE)
+7 SET DOC("text",VPRT,"clinicians",N,"signature")=$$SIG^VPRDTIU(IEN)
+8 QUIT
+9 ;
+10 ; ------------ Get/apply search criteria ------------
+11 ; [from DOCUMENT^VPRDJ0]
+12 ;
SETUP ; -- convert FILTER("attribute") = value to TIU criteria
+1 ; Expects: FILTER("category") = code (see $$CATG)
+2 ; FILTER("status") = 'signed','unsigned','all'
+3 ; Returns: CLASS,[SUBCLASS,STATUS]
+4 ;
+5 NEW TYPE,STS,CP
+6 SET TYPE=$$UP^XLFSTR($GET(FILTER("category")))
+7 SET CLASS=0
SET (SUBCLASS,STATUS)=""
+8 ;
+9 ; status [default='signed']
+10 SET STS=$$LOW^XLFSTR($GET(FILTER("status")))
+11 ;TIUSRVLO statuses
SET STATUS=$SELECT(STS?1"unsig".E:2,STS="all":"5^2",1:5)
+12 ;
+13 ; all documents
+14 if TYPE=""
SET TYPE="ALL"
+15 IF TYPE="ALL"
SET CLASS="3^244^"_+$$CLASS^TIUSROI("SURGICAL REPORTS")_"^CP^LR^RA"
QUIT
+16 ;
+17 ;Progress Notes
IF TYPE="PN"
SET CLASS=3
QUIT
+18 ;Consults
IF TYPE="CR"
SET CLASS=3
SET SUBCLASS=$$CLASS^TIUCNSLT
QUIT
+19 ;CWAD
IF TYPE="CWAD"
SET CLASS=3
SET SUBCLASS="25^27^30^31"
QUIT
+20 ;Crisis Note
IF TYPE="C"
SET CLASS=3
SET SUBCLASS=30
QUIT
+21 ;Clinical Warning
IF TYPE="W"
SET CLASS=3
SET SUBCLASS=31
QUIT
+22 ;Allergy Note
IF TYPE="A"
SET CLASS=3
SET SUBCLASS=25
QUIT
+23 ;Advance Directive
IF TYPE="D"
SET CLASS=3
SET SUBCLASS=27
QUIT
+24 ;
+25 ;Discharge Summary
IF TYPE="DS"
SET CLASS=244
QUIT
+26 ;
+27 IF TYPE="SR"
SET CLASS=$$CLASS^TIUSROI("SURGICAL REPORTS")
QUIT
+28 ;Clin Procedures
IF TYPE="CP"
Begin DoDot:1
+29 ; if unsigned,
IF STATUS'=2
SET CLASS="CP"
+30 ; use TIU class#
IF '$TEST
DO CPCLASS^TIUCP(.CP)
SET CLASS=CP
End DoDot:1
QUIT
+31 ;
+32 ;Lab/Pathology
IF TYPE="LR"
SET CLASS=$SELECT(STATUS=2:$$LR,1:"LR")
QUIT
+33 ;
+34 ;Radiology
IF TYPE="RA"
SET CLASS="RA"
QUIT
+35 ;
+36 QUIT
+37 ;
LR() ; -- Return ien of Lab class
+1 NEW Y
SET Y=+$ORDER(^TIU(8925.1,"B","LR LABORATORY REPORTS",0))
+2 IF Y>0
IF $SELECT($PIECE($GET(^TIU(8925.1,Y,0)),U,4)="CL":0,$PIECE($GET(^(0)),U,4)="DC":0,1:1)
SET Y=0
+3 QUIT Y
+4 ;
MATCH(DOC,STS) ; -- Return 1 or 0, if document DA matches search criteria
+1 NEW Y,DA,LOCAL,NATL,X0,OK
SET Y=0
+2 SET DA=+$GET(DOC)
if DA<1
GOTO MQ
+3 ; include addenda if pulling only unsigned items
+4 IF $PIECE(DOC,U,2)?1"Addendum ".E
IF STATUS'=2
GOTO MQ
+5 ; TIU unsigned list can include completed parent notes
+6 IF $GET(STS)=2
IF $PIECE(DOC,U,7)'="unsigned"
GOTO MQ
+7 ;local Title 8925.1 ien
SET LOCAL=$$GET1^DIQ(8925,DA_",",.01,"I")
+8 IF $LENGTH(SUBCLASS)
Begin DoDot:1
+9 NEW I,X
SET OK=0
+10 FOR I=1:1:$LENGTH(SUBCLASS,"^")
SET X=$PIECE(SUBCLASS,U,I)
IF $$ISA^TIULX(LOCAL,X)
SET OK=1
QUIT
End DoDot:1
if 'OK
GOTO MQ
+11 SET Y=1
MQ QUIT Y
+1 ;
TYPE(X) ; -- Return name of category type X
+1 SET X=$GET(X)
+2 IF X="PN"
QUIT "Progress Note"
+3 IF X="DS"
QUIT "Discharge Summary"
+4 IF X="CP"
QUIT "Clinical Procedure"
+5 IF X="SR"
QUIT "Surgery Report"
+6 IF X="LR"
QUIT "Laboratory Report"
+7 IF X="RA"
QUIT "Radiology Report"
+8 IF X="CR"
QUIT "Consult Report"
+9 IF X="C"
QUIT "Crisis Note"
+10 IF X="W"
QUIT "Clinical Warning"
+11 IF X="A"
QUIT "Allergy/Adverse Reaction"
+12 IF X="D"
QUIT "Advance Directive"
+13 QUIT ""
