SCRPW306 ; BPFO/JRC - ACRP Ad Hoc Report for Perf Monitors; 6-19-2003
;;5.3;Scheduling;**292**;Aug 13, 1993
;
PMPR(SDX) ;Provider signing progress note
K SDX N INFO,PTR
D GETTIU
S PTR=+$P(INFO,"^",1)
S:PTR SDX(1)=PTR_"^"_$P($G(^VA(200,PTR,0)),"^",1)
D NX Q
;
PMDT(SDX) ;Date progress notes was signed
K SDX N INFO,DATE
D GETTIU
S DATE=+$P(INFO,"^",2)
S:DATE SDX(1)=DATE_"^"_$$FMTE^XLFDT(DATE,"1D")
D NX Q
;
PMET(SDX) ;Elapsed time in (days) for provider to sign progress note
K SDX N INFO,ELAPSE
D GETTIU
S ELAPSE=$P(INFO,"^",3)
S:ELAPSE'="" SDX(1)=ELAPSE_"^"_ELAPSE
D NX Q
;
NX S:$D(SDX)<10 SDX(1)="~~~NONE~~~^~~~NONE~~~" Q
;
GETTIU ;Get data from TIU
;Input : SDOE - Pointer to Outpatient Encounter (#409.68)
; SDOE0 - Zero node of encounter
;Output : None
; INFO = P1 ^ P2 ^ P3
; P1 - Signing Provider (ptr)
; P2 - Date Signed (FM)
; P3 - Elapsed Time (day)
;Note : INFO will be set to NULL if a note signed by an
; acceptable provider is not found
;
N TIUINFO,PROV,DATE,ELAPSE
;Get progress note status/info
S TIUINFO=$$NOTEINF^SDPMUT2(SDOE)
S INFO=""
;Status not acceptable
I $P(TIUINFO,"^",2)'="B" Q
;Determine signing provider & date signed
S PROV=$P(TIUINFO,"^",5)
S DATE=$P(TIUINFO,"^",6)
I 'PROV S PROV=$P(TIUINFO,"^",3),DATE=$P(TIUINFO,"^",4)
;Determine elapsed time
S ELAPSE=$$FMDIFF^XLFDT(DATE,+SDOE0)
;Done
S INFO=PROV_"^"_DATE_"^"_ELAPSE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW306 1525 printed Sep 23, 2025@20:20 Page 2
SCRPW306 ; BPFO/JRC - ACRP Ad Hoc Report for Perf Monitors; 6-19-2003
+1 ;;5.3;Scheduling;**292**;Aug 13, 1993
+2 ;
PMPR(SDX) ;Provider signing progress note
+1 KILL SDX
NEW INFO,PTR
+2 DO GETTIU
+3 SET PTR=+$PIECE(INFO,"^",1)
+4 if PTR
SET SDX(1)=PTR_"^"_$PIECE($GET(^VA(200,PTR,0)),"^",1)
+5 DO NX
QUIT
+6 ;
PMDT(SDX) ;Date progress notes was signed
+1 KILL SDX
NEW INFO,DATE
+2 DO GETTIU
+3 SET DATE=+$PIECE(INFO,"^",2)
+4 if DATE
SET SDX(1)=DATE_"^"_$$FMTE^XLFDT(DATE,"1D")
+5 DO NX
QUIT
+6 ;
PMET(SDX) ;Elapsed time in (days) for provider to sign progress note
+1 KILL SDX
NEW INFO,ELAPSE
+2 DO GETTIU
+3 SET ELAPSE=$PIECE(INFO,"^",3)
+4 if ELAPSE'=""
SET SDX(1)=ELAPSE_"^"_ELAPSE
+5 DO NX
QUIT
+6 ;
NX if $DATA(SDX)<10
SET SDX(1)="~~~NONE~~~^~~~NONE~~~"
QUIT
+1 ;
GETTIU ;Get data from TIU
+1 ;Input : SDOE - Pointer to Outpatient Encounter (#409.68)
+2 ; SDOE0 - Zero node of encounter
+3 ;Output : None
+4 ; INFO = P1 ^ P2 ^ P3
+5 ; P1 - Signing Provider (ptr)
+6 ; P2 - Date Signed (FM)
+7 ; P3 - Elapsed Time (day)
+8 ;Note : INFO will be set to NULL if a note signed by an
+9 ; acceptable provider is not found
+10 ;
+11 NEW TIUINFO,PROV,DATE,ELAPSE
+12 ;Get progress note status/info
+13 SET TIUINFO=$$NOTEINF^SDPMUT2(SDOE)
+14 SET INFO=""
+15 ;Status not acceptable
+16 IF $PIECE(TIUINFO,"^",2)'="B"
QUIT
+17 ;Determine signing provider & date signed
+18 SET PROV=$PIECE(TIUINFO,"^",5)
+19 SET DATE=$PIECE(TIUINFO,"^",6)
+20 IF 'PROV
SET PROV=$PIECE(TIUINFO,"^",3)
SET DATE=$PIECE(TIUINFO,"^",4)
+21 ;Determine elapsed time
+22 SET ELAPSE=$$FMDIFF^XLFDT(DATE,+SDOE0)
+23 ;Done
+24 SET INFO=PROV_"^"_DATE_"^"_ELAPSE
+25 QUIT
