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

SDPMUT1.m

Go to the documentation of this file.
  1. SDPMUT1 ; BPFO/JRC - Performance Monitors Utilities; 6-19-2003 ; 12/22/03 11:32am [6/21/04 3:26pm]
  1. ;;5.3;SCHEDULING;**292,335,371**;AUGUST 13, 1993
  1. ;
  1. GETDATA(SCRNARR,SORTARR,OUTARR) ;Get progress note compliance information
  1. ;Input : SCRNARR - Screening array full global reference
  1. ; SORTARR - Sort array full global reference
  1. ; OUTARR - Output array full global reference
  1. ;Output : None
  1. ; @OUTARR@("SUMMARY") = Enc^Comply^ ^Prov^Stop^ET^Scan^Signed
  1. ; Enc - Number of encounters checked for compliance
  1. ; Comply - Compliant encounters (note signed w/in time limit)
  1. ; Prov - Unique primary encounter providers
  1. ; Stop - Unique primary stop codes
  1. ; ET - Total elapsed time (days) to sign PN
  1. ; Scan - Encounters with scanned notes
  1. ; Signed - Encounters with signed notes
  1. ; @OUTARR@("SUBTOTAL",SUB1) = SUMMARY node for sort level 1
  1. ; @OUTARR@("SUMMARY","PI") = F0^F1^F2^F3^F4^F5^F6^F7^F8^F9^F10^F11
  1. ; Fx - Notes signed in x to X+1 days
  1. ; F11 - Notes signed in 10 or more days
  1. ; @OUTARR@("SUBTOTAL",SUB1,"PI") = PI node for sort level 1
  1. ; @OUTARR@("DETAIL",SUB1,SUB2,DFN,PtrEnc) = Prov^DT^ET
  1. ; Prov - TIU Provider
  1. ; DT - Date Provider signed progress note
  1. ; ET - Number of days that elpased before signing PN
  1. ;Note : OUTARR is initialized (i.e. KILLed) on input
  1. ; : When division is used as a sorting subscript,
  1. ; DivisionName^DivisionNumber is used as the subscript
  1. ; : Time is stripped from the encounter date when used as a
  1. ; sorting subscript
  1. ;
  1. ;Declare variables
  1. N PTRENC,DATE,ENDDATE,UNQARR,STOP,LOOP
  1. ;Get begin and end dates for scan
  1. S DATE=$G(@SCRNARR@("RANGE"))
  1. S ENDDATE=$P(DATE,U,2)
  1. S DATE=$P(DATE,U,1)
  1. Q:('DATE)!('ENDDATE)
  1. S DATE=$P(DATE,".",1)-.000001
  1. S $P(ENDDATE,".",2)=999999
  1. ;Initialize output and array used to track uniques
  1. S UNQARR=$NA(^TMP("SDPMUT1-UNIQUE",$J))
  1. K @UNQARR,@OUTARR
  1. ;Scan
  1. S STOP=0
  1. F LOOP=1:1 S DATE=+$O(^SCE("B",DATE)) Q:('DATE)!(DATE>ENDDATE) D Q:STOP
  1. .S PTRENC=0
  1. .F S PTRENC=+$O(^SCE("B",DATE,PTRENC)) Q:'PTRENC D Q:STOP
  1. ..;Task asked to stop
  1. ..I '(LOOP#100) S STOP=$$S^%ZTLOAD() Q:STOP
  1. ..;Screen out encounter
  1. ..Q:$$SCREEN^SDPMUT2(PTRENC,SCRNARR)
  1. ..;Set output array
  1. ..D GET
  1. ;Cleanup and quit
  1. K @UNQARR
  1. Q
  1. GET ;Get info & establish output array for GETDATA
  1. ;Input : PTRENC - Pointer to Outpatient Encounter file
  1. ; UNQARR - Array to use for unique calculations
  1. ; Input parameters for GETDATA (SCRNARR, SORTARR, and OUTARR)
  1. ;Ouput : See GETDATA for format of nodes set into OUTARR
  1. ; Unique Stop Codes
  1. ; @UNQARR@("SUMMARY","STOP",SUB1,PtrStopCode)
  1. ; @UNQARR@("SUBTOTAL","STOP",SUB1,PtrStopCode)
  1. ; Unique Primary Encounter Providers
  1. ; @UNQARR@("SUMMARY","PROV",SUB1,PtrProvider)
  1. ; @UNQARR@("SUBTOTAL","PROV",SUB1,PtrProvider)
  1. ;Declare variables
  1. N DFN,DIV,CLINIC,NODE,NOTEINFO,PROV,ENCDT,SUB1,SUB2,TIUPROV
  1. N TIUDT,TIUET,SUMNODE,SUBNODE,ESUB1,ESUB2,SCODE,X
  1. S NODE=^SCE(PTRENC,0)
  1. S DFN=+$P(NODE,U,2),DIV=+$P(NODE,U,11),CLINIC=+$P(NODE,U,4)
  1. S SCODE=+$P(NODE,U,3),ENCDT=+NODE
  1. ;Get primary encounter provider
  1. S PROV=$$ENCPROV^SDPMUT2(PTRENC)
  1. ;Set sorting subscripts (ESUB1 & ESUB2)
  1. ; If SUBx = 1 Set sorting criteria to division
  1. ; If SUBx = 2 Set soring criteria to clinic
  1. ; If SUBx = 3 Set sorting criteria to Provider
  1. ; If SUBx = 4 Set sorting criteria to Stop Code
  1. ; If SUBx = 5 Set sorting criteria to Encounter Date
  1. ; If SUBx = 6 Set sorting criteria to Patient
  1. S NODE=@SORTARR
  1. S SUB1=$P(NODE,"^",1)
  1. S SUB2=$P(NODE,"^",2)
  1. F NODE="SUB1","SUB2" D I @("E"_NODE)="" S @("E"_NODE)="UNKNOWN"
  1. .I @NODE=1 D Q
  1. ..S X=$G(^DG(40.8,DIV,0))
  1. ..S @("E"_NODE)=$P(X,U,1)_"^"_$P(X,U,2)
  1. .I @NODE=2 D Q
  1. ..S @("E"_NODE)=$P($G(^SC(CLINIC,0)),U,1)
  1. .I @NODE=3 D Q
  1. ..S @("E"_NODE)=$P($G(^VA(200,PROV,0)),U,1)
  1. .I @NODE=4 D Q
  1. ..S @("E"_NODE)=$P($G(^DIC(40.7,SCODE,0)),U,1)
  1. .I @NODE=5 D Q
  1. ..S @("E"_NODE)=$P(ENCDT,".",1)
  1. .I @NODE=6 D Q
  1. ..S @("E"_NODE)=$P($G(^DPT(DFN,0)),U,1)
  1. .S @("E"_NODE)="UNKNOWN"
  1. ;Increment Encounters for hospital and sort level 1
  1. S $P(@OUTARR@("SUMMARY"),U,1)=$P($G(@OUTARR@("SUMMARY")),U,1)+1
  1. S $P(@OUTARR@("SUBTOTAL",ESUB1),U,1)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,1)+1
  1. ;Get TIU information
  1. S NOTEINFO=$$NOTEINF^SDPMUT2(PTRENC)
  1. S (TIUPROV,TIUDT,TIUET)=""
  1. ;Only update performance indicators for note status of B
  1. I $P((NOTEINFO),U,2)="B" D
  1. .S TIUPROV=$P((NOTEINFO),U,5)
  1. .S TIUDT=$P((NOTEINFO),U,6)
  1. .I 'TIUPROV D
  1. ..S TIUPROV=$P((NOTEINFO),U,3)
  1. ..S TIUDT=$P((NOTEINFO),U,4)
  1. .S TIUET=$$FMDIFF^XLFDT(TIUDT,ENCDT)
  1. .I TIUET<0 Q
  1. .;Increment Compliant Notes for hospital and sort level 1
  1. .I TIUET'>@SCRNARR@("TLMT") D
  1. ..S $P(@OUTARR@("SUMMARY"),U,2)=$P($G(@OUTARR@("SUMMARY")),U,2)+1
  1. ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,2)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,2)+1
  1. .;Increment Total Elapsed Time for hospital and sort level 1
  1. .S $P(@OUTARR@("SUMMARY"),U,6)=$P($G(@OUTARR@("SUMMARY")),U,6)+TIUET
  1. .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,6)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,6)+TIUET
  1. .;Increment Total Signed Notes for hospital and sort level 1
  1. .S $P(@OUTARR@("SUMMARY"),U,8)=$P($G(@OUTARR@("SUMMARY")),U,8)+1
  1. .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,8)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,8)+1
  1. .;Update performance indicator node for hospital and sort level 1
  1. .S SUMNODE=$G(@OUTARR@("SUMMARY","PI"))
  1. .S SUBNODE=$G(@OUTARR@("SUBTOTAL",ESUB1,"PI"))
  1. .I TIUET'<0&(TIUET'>1) D
  1. ..S $P(SUMNODE,U,1)=$P($G(SUMNODE),U,1)+1
  1. ..S $P(SUBNODE,U,1)=$P($G(SUBNODE),U,1)+1
  1. .I TIUET>1&(TIUET'>2) D
  1. ..S $P(SUMNODE,U,2)=$P($G(SUMNODE),U,2)+1
  1. ..S $P(SUBNODE,U,2)=$P($G(SUBNODE),U,2)+1
  1. .I TIUET>2&(TIUET'>3) D
  1. ..S $P(SUMNODE,U,3)=$P($G(SUMNODE),U,3)+1
  1. ..S $P(SUBNODE,U,3)=$P($G(SUBNODE),U,3)+1
  1. .I TIUET>3&(TIUET'>4) D
  1. ..S $P(SUMNODE,U,4)=$P($G(SUMNODE),U,4)+1
  1. ..S $P(SUBNODE,U,4)=$P($G(SUBNODE),U,4)+1
  1. .I TIUET>4&(TIUET'>5) D
  1. ..S $P(SUMNODE,U,5)=$P($G(SUMNODE),U,5)+1
  1. ..S $P(SUBNODE,U,5)=$P($G(SUBNODE),U,5)+1
  1. .I TIUET>5&(TIUET'>6) D
  1. ..S $P(SUMNODE,U,6)=$P($G(SUMNODE),U,6)+1
  1. ..S $P(SUBNODE,U,6)=$P($G(SUBNODE),U,6)+1
  1. .I TIUET>6&(TIUET'>7) D
  1. ..S $P(SUMNODE,U,7)=$P($G(SUMNODE),U,7)+1
  1. ..S $P(SUBNODE,U,7)=$P($G(SUBNODE),U,7)+1
  1. .I TIUET>7&(TIUET'>8) D
  1. ..S $P(SUMNODE,U,8)=$P($G(SUMNODE),U,8)+1
  1. ..S $P(SUBNODE,U,8)=$P($G(SUBNODE),U,8)+1
  1. .I TIUET>8&(TIUET'>9) D
  1. ..S $P(SUMNODE,U,9)=$P($G(SUMNODE),U,9)+1
  1. ..S $P(SUBNODE,U,9)=$P($G(SUBNODE),U,9)+1
  1. .I TIUET>9&(TIUET'>10) D
  1. ..S $P(SUMNODE,U,10)=$P($G(SUMNODE),U,10)+1
  1. ..S $P(SUBNODE,U,10)=$P($G(SUBNODE),U,10)+1
  1. .I TIUET>10 D
  1. ..S $P(SUMNODE,U,11)=$P($G(SUMNODE),U,11)+1
  1. ..S $P(SUBNODE,U,11)=$P($G(SUBNODE),U,11)+1
  1. .S @OUTARR@("SUMMARY","PI")=SUMNODE
  1. .S @OUTARR@("SUBTOTAL",ESUB1,"PI")=SUBNODE
  1. .Q
  1. ;Increment Scanned Notes for hospital and sort level 1 (if required)
  1. I @SCRNARR@("SCANNED")&($P(NOTEINFO,U,2)["D") D
  1. .S $P(@OUTARR@("SUMMARY"),U,7)=$P($G(@OUTARR@("SUMMARY")),U,7)+1
  1. .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,7)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,7)+1
  1. .Q
  1. ;Only update performance indicators for note status of A
  1. I $P((NOTEINFO),U,2)="A" D
  1. .S $P(@OUTARR@("SUMMARY"),U,9)=$P($G(@OUTARR@("SUMMARY")),U,9)+1
  1. .S $P(@OUTARR@("SUBTOTAL",ESUB1),U,9)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,9)+1
  1. .Q
  1. ;Increment unique Stop Codes for hospital and sort level 1
  1. I SCODE D
  1. .I '($D(@UNQARR@("SUMMARY","STOP",ESUB1,SCODE))#2) D
  1. ..S $P(@OUTARR@("SUMMARY"),U,5)=$P($G(@OUTARR@("SUMMARY")),U,5)+1
  1. ..S @UNQARR@("SUMMARY","STOP",ESUB1,SCODE)=""
  1. ..Q
  1. .I '($D(@UNQARR@("SUBTOTAL","STOP",ESUB1,SCODE))#2) D
  1. ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,5)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,5)+1
  1. ..S @UNQARR@("SUBTOTAL","STOP",ESUB1,SCODE)=""
  1. ..Q
  1. .Q
  1. ;Increment unique Providers for hospital and sort level 1
  1. I PROV D
  1. .I '($D(@UNQARR@("SUMMARY","PROV",ESUB1,PROV))#2) D
  1. ..S $P(@OUTARR@("SUMMARY"),U,4)=$P($G(@OUTARR@("SUMMARY")),U,4)+1
  1. ..S @UNQARR@("SUMMARY","PROV",ESUB1,PROV)=""
  1. ..Q
  1. .I '($D(@UNQARR@("SUBTOTAL","PROV",ESUB1,PROV))#2) D
  1. ..S $P(@OUTARR@("SUBTOTAL",ESUB1),U,4)=$P($G(@OUTARR@("SUBTOTAL",ESUB1)),U,4)+1
  1. ..S @UNQARR@("SUBTOTAL","PROV",ESUB1,PROV)=""
  1. ..Q
  1. .Q
  1. ;Set detailed node
  1. S @OUTARR@("DETAIL",ESUB1,ESUB2,DFN,PTRENC)=TIUPROV_"^"_TIUDT_"^"_TIUET
  1. Q