| [613] | 1 | SCRPW306 ; BPFO/JRC - ACRP Ad Hoc Report for Perf Monitors; 6-19-2003
|
|---|
| 2 | ;;5.3;Scheduling;**292**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | PMPR(SDX) ;Provider signing progress note
|
|---|
| 5 | K SDX N INFO,PTR
|
|---|
| 6 | D GETTIU
|
|---|
| 7 | S PTR=+$P(INFO,"^",1)
|
|---|
| 8 | S:PTR SDX(1)=PTR_"^"_$P($G(^VA(200,PTR,0)),"^",1)
|
|---|
| 9 | D NX Q
|
|---|
| 10 | ;
|
|---|
| 11 | PMDT(SDX) ;Date progress notes was signed
|
|---|
| 12 | K SDX N INFO,DATE
|
|---|
| 13 | D GETTIU
|
|---|
| 14 | S DATE=+$P(INFO,"^",2)
|
|---|
| 15 | S:DATE SDX(1)=DATE_"^"_$$FMTE^XLFDT(DATE,"1D")
|
|---|
| 16 | D NX Q
|
|---|
| 17 | ;
|
|---|
| 18 | PMET(SDX) ;Elapsed time in (days) for provider to sign progress note
|
|---|
| 19 | K SDX N INFO,ELAPSE
|
|---|
| 20 | D GETTIU
|
|---|
| 21 | S ELAPSE=$P(INFO,"^",3)
|
|---|
| 22 | S:ELAPSE'="" SDX(1)=ELAPSE_"^"_ELAPSE
|
|---|
| 23 | D NX Q
|
|---|
| 24 | ;
|
|---|
| 25 | NX S:$D(SDX)<10 SDX(1)="~~~NONE~~~^~~~NONE~~~" Q
|
|---|
| 26 | ;
|
|---|
| 27 | GETTIU ;Get data from TIU
|
|---|
| 28 | ;Input : SDOE - Pointer to Outpatient Encounter (#409.68)
|
|---|
| 29 | ; SDOE0 - Zero node of encounter
|
|---|
| 30 | ;Output : None
|
|---|
| 31 | ; INFO = P1 ^ P2 ^ P3
|
|---|
| 32 | ; P1 - Signing Provider (ptr)
|
|---|
| 33 | ; P2 - Date Signed (FM)
|
|---|
| 34 | ; P3 - Elapsed Time (day)
|
|---|
| 35 | ;Note : INFO will be set to NULL if a note signed by an
|
|---|
| 36 | ; acceptable provider is not found
|
|---|
| 37 | ;
|
|---|
| 38 | N TIUINFO,PROV,DATE,ELAPSE
|
|---|
| 39 | ;Get progress note status/info
|
|---|
| 40 | S TIUINFO=$$NOTEINF^SDPMUT2(SDOE)
|
|---|
| 41 | S INFO=""
|
|---|
| 42 | ;Status not acceptable
|
|---|
| 43 | I $P(TIUINFO,"^",2)'="B" Q
|
|---|
| 44 | ;Determine signing provider & date signed
|
|---|
| 45 | S PROV=$P(TIUINFO,"^",5)
|
|---|
| 46 | S DATE=$P(TIUINFO,"^",6)
|
|---|
| 47 | I 'PROV S PROV=$P(TIUINFO,"^",3),DATE=$P(TIUINFO,"^",4)
|
|---|
| 48 | ;Determine elapsed time
|
|---|
| 49 | S ELAPSE=$$FMDIFF^XLFDT(DATE,+SDOE0)
|
|---|
| 50 | ;Done
|
|---|
| 51 | S INFO=PROV_"^"_DATE_"^"_ELAPSE
|
|---|
| 52 | Q
|
|---|
