TIUPXPM ;SLC OIFO/DKK,GSS - ADDITIONAL PERFORMANCE MONITORS ; 07/01/03
;;1.0;TEXT INTEGRATION UTILITIES;**168**Jun 20, 1997
;External reference to File ^AUPNVPRV supported by DBIA 1541
;External reference to File ^AUPNVSIT supported by DBIA 1625 & DBIA 3580
;-----------------------------------
;Determines if note has been appropriately signed in a timely manner.
;Originally written as an API for use by PIMS
;
;Note
;Category Type
; A No note for the Visit IEN
; B Acceptable Note ('signed')
; C Unacceptable Note ('unsigned')
; D Scanned Image
; E Purged, Deleted, or Retracted Note
;
;TIU Note Status Possible
;Code Description Category
;none No corresponding Progress Note for VIEN A
; 1 Undictated C or D
; 2 Untranscribed C
; 3 Unreleased -
; 4 Unverified C or D
; 5 Unsigned C
; 6 Uncosigned C
; 7 Completed B or C
; 8 Amended B or C
; 9 Purged E
;11 Active C
;13 Inactive C or D
;14 Deleted E
;15 Retracted E
;variable Scanned Image D
;
;Primary variables Used:
;ARY() = Array of all visit providers returned by GETPRV^PXAPIOE
;CSTATC = ","_Document status_","
;DOCTYP() = Array of all note types based on Progress Note Class
;SIG = Pointer to File #200 of signer^FM Date.Time of signing
;SIGA = Pointer to F#200 of Amended note signer^FM Date.Time
;SIGC = Pointer to F#200 of note Co-Signer^FM Date.Time
;STAT = Document status
;TIUIEN = TIU Note IEN
;VIEN = Visit IEN
;VPRV() = Array
;X,Y,Z = Scratch variables
;
;Returns:
;String with 6 fields ('^' delimiter)
; 1 VIEN
; 2 Note Category (A-E)
; 3 Signed By (pointer to File #200)
; 4 Signed Date.Time (FM format)
; 5 Co-signed By (pointer to File #200) - defined only if necessary
; 6 Co-signed Date.Time - defined only if necessary
;-------------------------
;
PM(VIEN) ; external access point
; quit and return null if visit IEN is null
I $G(VIEN)="" Q ""
N ARY,CSTATC,DATE,PC,SIG,SIGA,SIGC,STAT,TIUIEN,VPRV
S (TIUIEN,X,Z)=""
; get providers (returned in ARY array) who saw the patient
D GETPRV^PXAPIOE(VIEN,"ARY") ; DBIA 1541
; create VPRV array of valid providers
D PROV
; initalize return string
S Y=""
; looking for notes re: visit/encounter, get each document in turn
F S TIUIEN=$O(^TIU(8925,"V",VIEN,TIUIEN)) Q:TIUIEN="" D Q:$E(Y)="B"
. ; get status of note, signers, and dates
. D STAT
. ;
. ; Category B: Co-signed note by Primary Provider
. I $D(SIGC),$G(VPRV(+SIGC))="P" D Q:$E(Y)="B"
.. Q:'$D(^TIU(8925,TIUIEN,"TEXT"))
.. I STAT=7 S Y="B"_U_SIG_U_SIGC Q
.. I STAT=8 S Y="B"_U_SIGA_U_SIGC
. ;
. ; Cateogory B: Primary Provider signed & completed note
. I $D(SIG),$G(VPRV(+SIG))="P" D Q:$E(Y)="B"
.. I STAT=7,$D(^TIU(8925,TIUIEN,"TEXT")) S Y="B"_U_SIG_U_U
. ;
. ; Category B: Primary Provider Amended note
. I $D(SIGA),$G(VPRV(+SIGA))="P" D Q:$E(Y)="B"
.. I STAT=8,$D(^TIU(8925,TIUIEN,"TEXT")) S Y="B"_U_SIGA_U_U
. ;
. ; Category B: Signer a Secondary Provider but in VPRV & note complete
. I STAT=7,$D(SIG),$G(VPRV(+SIG))="S" S Y="B"_U_SIG_U_U Q
. ;
. ; Category D: Scanned Image
. I $D(^TIU(8925.91,"B",TIUIEN)) S Y="D"_U_U_U_U Q
. ;
. ; Category C: Unsigned note
. I ",1,2,4,5,6,7,8,11,13,"[CSTATC,Y="" S Y="C"_U_U_U_U Q
. ;
. ; Category E: Purged, deleted, or retracted
. I ",9,14,15,"[CSTATC,Y="" S Y="E"_U_U_U_U Q
;
; Category A: no note found for this visit
S:Y="" Y="A"_U_U_U_U
; return Y string w/ first piece being VIEN
S Y=VIEN_U_Y
Q Y
;
STAT ; get status of note and signer
K SIG,SIGA,SIGC
S STAT=$P($G(^TIU(8925,TIUIEN,0)),U,5),CSTATC=","_STAT_","
; document amended (STAT=8)
I STAT=8 S X=$G(^TIU(8925,TIUIEN,16)) D
. ; amended by ($P(X,U,2))
. I $P(X,U,2) S SIGA=$P(X,U,2)_U_$P(X,U)
S X=$G(^TIU(8925,TIUIEN,15))
; co-signature needed ($P(X,U,6)) 1=Yes, 0=No
; per J.Hawsey co-sig field is not reliably set, thus not used
; co-signer ($P(X,U,8))
I $P(X,U,8) S SIGC=$P(X,U,8)_U_$P(X,U,7)
; signer of document ($P(X,U,2))
I $P(X,U,2) S SIG=$P(X,U,2)_U_$P(X,U)
Q
;
PROV ; validate providers by $O through provider array (ARY) and
; creating VPRV array, where VPRV(VPRV)=Primary/Secondary^PersonClass
S X=""
F S X=$O(ARY(X)) Q:X="" D
. ; Z=VPRV^PTIEN^VIEN^Prim/Secondary^Op/Attend^Ptr2PersonClass
. S Z=ARY(X),VPRV=$P(Z,U)
. ; Get Person Class information at the time of the visit
. S PC=$P($$GET^XUA4A72(VPRV,+$G(^AUPNVSIT(VIEN,0))),U,7) ; DBIA 1625 & 3580
. S VPRV(VPRV)=$P(Z,U,4)
. ; quit if provider is Primary (that is, accept provider)
. Q:$P(VPRV(VPRV),U)="P"
. ; PA/NP's are V100000 through V100618, inclusive
. ; Physician (MD/DO) Resident, Allopathic is V115500
. ; Physician (MD/DO) Resident, Osteopathic is V115600
. ; if PC is any of the above, then accept provider, otherwise - don't
. ; note: already accepted Primary provider above
. I (PC]"V100618"!(PC']"V099999")),(PC'="V115500"),(PC'="V115600") S VPRV(VPRV)="X"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPXPM 5747 printed Apr 09, 2024@21:42:12 Page 2
TIUPXPM ;SLC OIFO/DKK,GSS - ADDITIONAL PERFORMANCE MONITORS ; 07/01/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**168**Jun 20, 1997
+2 ;External reference to File ^AUPNVPRV supported by DBIA 1541
+3 ;External reference to File ^AUPNVSIT supported by DBIA 1625 & DBIA 3580
+4 ;-----------------------------------
+5 ;Determines if note has been appropriately signed in a timely manner.
+6 ;Originally written as an API for use by PIMS
+7 ;
+8 ;Note
+9 ;Category Type
+10 ; A No note for the Visit IEN
+11 ; B Acceptable Note ('signed')
+12 ; C Unacceptable Note ('unsigned')
+13 ; D Scanned Image
+14 ; E Purged, Deleted, or Retracted Note
+15 ;
+16 ;TIU Note Status Possible
+17 ;Code Description Category
+18 ;none No corresponding Progress Note for VIEN A
+19 ; 1 Undictated C or D
+20 ; 2 Untranscribed C
+21 ; 3 Unreleased -
+22 ; 4 Unverified C or D
+23 ; 5 Unsigned C
+24 ; 6 Uncosigned C
+25 ; 7 Completed B or C
+26 ; 8 Amended B or C
+27 ; 9 Purged E
+28 ;11 Active C
+29 ;13 Inactive C or D
+30 ;14 Deleted E
+31 ;15 Retracted E
+32 ;variable Scanned Image D
+33 ;
+34 ;Primary variables Used:
+35 ;ARY() = Array of all visit providers returned by GETPRV^PXAPIOE
+36 ;CSTATC = ","_Document status_","
+37 ;DOCTYP() = Array of all note types based on Progress Note Class
+38 ;SIG = Pointer to File #200 of signer^FM Date.Time of signing
+39 ;SIGA = Pointer to F#200 of Amended note signer^FM Date.Time
+40 ;SIGC = Pointer to F#200 of note Co-Signer^FM Date.Time
+41 ;STAT = Document status
+42 ;TIUIEN = TIU Note IEN
+43 ;VIEN = Visit IEN
+44 ;VPRV() = Array
+45 ;X,Y,Z = Scratch variables
+46 ;
+47 ;Returns:
+48 ;String with 6 fields ('^' delimiter)
+49 ; 1 VIEN
+50 ; 2 Note Category (A-E)
+51 ; 3 Signed By (pointer to File #200)
+52 ; 4 Signed Date.Time (FM format)
+53 ; 5 Co-signed By (pointer to File #200) - defined only if necessary
+54 ; 6 Co-signed Date.Time - defined only if necessary
+55 ;-------------------------
+56 ;
PM(VIEN) ; external access point
+1 ; quit and return null if visit IEN is null
+2 IF $GET(VIEN)=""
QUIT ""
+3 NEW ARY,CSTATC,DATE,PC,SIG,SIGA,SIGC,STAT,TIUIEN,VPRV
+4 SET (TIUIEN,X,Z)=""
+5 ; get providers (returned in ARY array) who saw the patient
+6 ; DBIA 1541
DO GETPRV^PXAPIOE(VIEN,"ARY")
+7 ; create VPRV array of valid providers
+8 DO PROV
+9 ; initalize return string
+10 SET Y=""
+11 ; looking for notes re: visit/encounter, get each document in turn
+12 FOR
SET TIUIEN=$ORDER(^TIU(8925,"V",VIEN,TIUIEN))
if TIUIEN=""
QUIT
Begin DoDot:1
+13 ; get status of note, signers, and dates
+14 DO STAT
+15 ;
+16 ; Category B: Co-signed note by Primary Provider
+17 IF $DATA(SIGC)
IF $GET(VPRV(+SIGC))="P"
Begin DoDot:2
+18 if '$DATA(^TIU(8925,TIUIEN,"TEXT"))
QUIT
+19 IF STAT=7
SET Y="B"_U_SIG_U_SIGC
QUIT
+20 IF STAT=8
SET Y="B"_U_SIGA_U_SIGC
End DoDot:2
if $EXTRACT(Y)="B"
QUIT
+21 ;
+22 ; Cateogory B: Primary Provider signed & completed note
+23 IF $DATA(SIG)
IF $GET(VPRV(+SIG))="P"
Begin DoDot:2
+24 IF STAT=7
IF $DATA(^TIU(8925,TIUIEN,"TEXT"))
SET Y="B"_U_SIG_U_U
End DoDot:2
if $EXTRACT(Y)="B"
QUIT
+25 ;
+26 ; Category B: Primary Provider Amended note
+27 IF $DATA(SIGA)
IF $GET(VPRV(+SIGA))="P"
Begin DoDot:2
+28 IF STAT=8
IF $DATA(^TIU(8925,TIUIEN,"TEXT"))
SET Y="B"_U_SIGA_U_U
End DoDot:2
if $EXTRACT(Y)="B"
QUIT
+29 ;
+30 ; Category B: Signer a Secondary Provider but in VPRV & note complete
+31 IF STAT=7
IF $DATA(SIG)
IF $GET(VPRV(+SIG))="S"
SET Y="B"_U_SIG_U_U
QUIT
+32 ;
+33 ; Category D: Scanned Image
+34 IF $DATA(^TIU(8925.91,"B",TIUIEN))
SET Y="D"_U_U_U_U
QUIT
+35 ;
+36 ; Category C: Unsigned note
+37 IF ",1,2,4,5,6,7,8,11,13,"[CSTATC
IF Y=""
SET Y="C"_U_U_U_U
QUIT
+38 ;
+39 ; Category E: Purged, deleted, or retracted
+40 IF ",9,14,15,"[CSTATC
IF Y=""
SET Y="E"_U_U_U_U
QUIT
End DoDot:1
if $EXTRACT(Y)="B"
QUIT
+41 ;
+42 ; Category A: no note found for this visit
+43 if Y=""
SET Y="A"_U_U_U_U
+44 ; return Y string w/ first piece being VIEN
+45 SET Y=VIEN_U_Y
+46 QUIT Y
+47 ;
STAT ; get status of note and signer
+1 KILL SIG,SIGA,SIGC
+2 SET STAT=$PIECE($GET(^TIU(8925,TIUIEN,0)),U,5)
SET CSTATC=","_STAT_","
+3 ; document amended (STAT=8)
+4 IF STAT=8
SET X=$GET(^TIU(8925,TIUIEN,16))
Begin DoDot:1
+5 ; amended by ($P(X,U,2))
+6 IF $PIECE(X,U,2)
SET SIGA=$PIECE(X,U,2)_U_$PIECE(X,U)
End DoDot:1
+7 SET X=$GET(^TIU(8925,TIUIEN,15))
+8 ; co-signature needed ($P(X,U,6)) 1=Yes, 0=No
+9 ; per J.Hawsey co-sig field is not reliably set, thus not used
+10 ; co-signer ($P(X,U,8))
+11 IF $PIECE(X,U,8)
SET SIGC=$PIECE(X,U,8)_U_$PIECE(X,U,7)
+12 ; signer of document ($P(X,U,2))
+13 IF $PIECE(X,U,2)
SET SIG=$PIECE(X,U,2)_U_$PIECE(X,U)
+14 QUIT
+15 ;
PROV ; validate providers by $O through provider array (ARY) and
+1 ; creating VPRV array, where VPRV(VPRV)=Primary/Secondary^PersonClass
+2 SET X=""
+3 FOR
SET X=$ORDER(ARY(X))
if X=""
QUIT
Begin DoDot:1
+4 ; Z=VPRV^PTIEN^VIEN^Prim/Secondary^Op/Attend^Ptr2PersonClass
+5 SET Z=ARY(X)
SET VPRV=$PIECE(Z,U)
+6 ; Get Person Class information at the time of the visit
+7 ; DBIA 1625 & 3580
SET PC=$PIECE($$GET^XUA4A72(VPRV,+$GET(^AUPNVSIT(VIEN,0))),U,7)
+8 SET VPRV(VPRV)=$PIECE(Z,U,4)
+9 ; quit if provider is Primary (that is, accept provider)
+10 if $PIECE(VPRV(VPRV),U)="P"
QUIT
+11 ; PA/NP's are V100000 through V100618, inclusive
+12 ; Physician (MD/DO) Resident, Allopathic is V115500
+13 ; Physician (MD/DO) Resident, Osteopathic is V115600
+14 ; if PC is any of the above, then accept provider, otherwise - don't
+15 ; note: already accepted Primary provider above
+16 IF (PC]"V100618"!(PC']"V099999"))
IF (PC'="V115500")
IF (PC'="V115600")
SET VPRV(VPRV)="X"
End DoDot:1
+17 QUIT
