- 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 Feb 19, 2025@00:10:06 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
