source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW306.m@ 1251

Last change on this file since 1251 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1SCRPW306 ; BPFO/JRC - ACRP Ad Hoc Report for Perf Monitors; 6-19-2003
2 ;;5.3;Scheduling;**292**;Aug 13, 1993
3 ;
4PMPR(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 ;
11PMDT(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 ;
18PMET(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 ;
25NX S:$D(SDX)<10 SDX(1)="~~~NONE~~~^~~~NONE~~~" Q
26 ;
27GETTIU ;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
Note: See TracBrowser for help on using the repository browser.