SCRPW306.m

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 ---SCRPW306   1525     printed  Apr 09, 2024@21:58:10                                                                                                                                                                                                    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