source: FOIAVistA/trunk/r/MEDICINE-MC/MCWORKLD.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1MCWORKLD ;WISC/RMP-Workload reporting ;4/8/97 07:47
2 ;;2.3;Medicine;**8**;09/13/1996
3 ;Routine which delivers a Mail message to the
4 ;specified Device(s) and Mailgroup(s) when a procedure
5 ;with an assigned CPT code has been released with a signature
6 ;
7 N CNT,DEVICE,MAILGRP,ARRAY
8 Q:$P($G(^MCAR(690.1,1,0)),U,7)'="Y" ;Check Workload toggle
9 Q:'($D(^MCAR(MCFILE,MCARGDA,0))#2) ;Check o node for G.P. patch
10 Q:$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,7)["S" ;Don't send a message
11 ;for a superceded record
12 D TEXT(MCFILE,MCARGDA,.ARRAY) ;Check for completeness
13 Q:'$D(ARRAY)
14 ;Device/Mailgroup parameter loading
15 I $D(^MCAR(690.1,1,1,0)) D
16 .S CNT=0
17 .F S CNT=$O(^MCAR(690.1,1,2,CNT)) Q:CNT'?1N.N D
18 ..Q:'$D(^MCAR(690.1,1,2,CNT,0))
19 ..N MCARCNT S MCARCNT=^MCAR(690.1,1,2,CNT,0)
20 ..S DEVICE(CNT)=$P(^%ZIS(1,MCARCNT,0),U)
21 ..Q
22 .Q
23 I $D(^MCAR(690.1,1,2,0)) D
24 .S CNT=0
25 .F S CNT=$O(^MCAR(690.1,1,1,CNT)) Q:CNT'?1N.N D
26 ..Q:'$D(^MCAR(690.1,1,1,CNT,0))
27 ..N MCARCNT S MCARCNT=^MCAR(690.1,1,1,CNT,0)
28 ..S MAILGRP(CNT)=$P(^XMB(3.8,MCARCNT,0),U)
29 ..Q
30 .Q
31 ;Q:($G(DEVICE(1))=0)&($G(MAILGRP(1))=0)
32 Q:($D(DEVICE)=0)&($D(MAILGRP)=0)
33 ; Mailman parameters
34 S XMSUB="Completed Coded Medicine Procedure"
35 S XMTEXT="ARRAY(",XMDUZ=DUZ,XMCHAN=""
36 S CNT=0 F S CNT=$O(DEVICE(CNT)) Q:CNT="" S XMY("D."_DEVICE(CNT))=""
37 S CNT=0 F S CNT=$O(MAILGRP(CNT)) Q:CNT="" S XMY("G."_MAILGRP(CNT))=""
38 D ^XMD
39 D KILL^XM
40 Q
41 ;
42TEXT(MCFILE,MCARGDA,ARRAY) ;
43 ;Report variables:
44 ;DFN -- Patient ID, pointer to the Patient file (2)
45 ;PRID -- Provider ID, DUZ or pointer to the New Person file (200)
46 ;PRNAME -- Provider Name
47 ;PDATET -- Procedure Date/Time, DATE SIGNED
48 ;CPT -- CPT code, Code associated throught the Procedure Term file
49 N PTMP,PRNAME,CPT,MCDATET,SSN
50 K ARRAY
51 S PRID=$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,4)
52 S FMDT=$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,6),Y=FMDT
53 S DFN=$$DFN(MCFILE,MCARGDA)
54 S CPT=$$CPT(MCFILE,MCARGDA)
55 I (PRID="")!(FMDT="")!(DFN="")!(CPT="") Q
56 D DD^%DT S MCDATET=Y
57 ; ------------------------
58 ; SSN = Enternal Format of the patients SSN.
59 ; ------------------------
60 D DEM^VADPT S MCARNM=VADM(1),SSN=$P(VADM(2),U,2) D KVAR^VADPT
61 S PTMP=$P(^VA(200,PRID,0),U),PRNAME=$P(PTMP,",",2)_" "_$P(PTMP,",")
62 S ARRAY(1)="Patient: "_MCARNM
63 S ARRAY(2)="SSN: "_SSN
64 S ARRAY(3)="Procedure: "_CPT
65 S ARRAY(4)="Date/Time: "_MCDATET
66 S ARRAY(5)="Provider: "_PRNAME
67 Q
68 ;
69CPT(FILE,DA) ;
70 N TEMP,IEN,CPT,PRO
71 S CPT=""
72 S MCARP=$O(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0))
73 S IEN=$O(^MCAR(694.8,"PS",MCARP,0))
74 ;Q:IEN=""
75 I IEN]"",$D(^MCAR(694.8,IEN,1,0)) S TEMP=0,PRO=$P($G(^MCAR(694.8,IEN,0)),U) D
76 .F Q:CPT?1N.N S TEMP=$O(^MCAR(694.8,IEN,1,TEMP)) Q:TEMP'?1N.N D
77 ..I $P($P(^(TEMP,0),U),";",2)["ICPT(" S CPT=$P($P(^(0),U),";")
78 ..Q
79 .S CPT=PRO_" "_CPT ;V2.3, E3R 8219, JCC, 5/13/96
80 Q CPT
81 ;
82DFN(FILE,DA) ;
83 N TEMP
84 ;S TEMP=$P(^DD(FILE,$$PATFLD(FILE,DA),0),U,4)
85 S TEMP=$$GET1^DID(FILE,$$PATFLD(FILE,DA),"","GLOBAL SUBSCRIPT LOCATION")
86 Q $P($G(^MCAR(FILE,MCARGDA,$P(TEMP,";"))),U,$P(TEMP,";",2))
87 ;V2.3, FIX UNDEF, JCC, 5/21/96
88PATFLD(FILE,DA) ;
89 N TEMP
90 S TEMP=$G(^MCAR(697.2,$O(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0)),0))
91 Q $P(TEMP,U,12)
92MCPRO(MCFILE,MCARGDA) ;694(0;3),699(0;12),699.5(0;6)
93 ;HAVE MULTIPLE FILE 697.2 ENTRIES
94 I (MCFILE=694)!(MCFILE=699)!(MCFILE=699.5) Q $$MCP(MCFILE,MCARGDA) ;V2.3, CHGED SECOND 699 TO 699.5, JCC, 6/17/96
95 Q $P(^MCAR(697.2,$O(^MCAR(697.2,"C","MCAR("_MCFILE,0)),0),U)
96MCP(MCFILE,MCARGDA) ;
97 Q $P(^MCAR(697.2,$P($G(^MCAR(MCFILE,MCARGDA,$$NODE(MCFILE))),U,$$PIECE(MCFILE)),0),U)
98NODE(MCFILE) ;
99 Q $S(1:0) ;694&699&699.5 use the 0 node
100PIECE(MCFILE) ;
101 Q $S(MCFILE=694:3,MCFILE=699:12,MCFILE=699.5:6,1:0)
102WLTOG ;Medicine Workload reporting Toggle
103 ;S DIE=690.1,DA=1,DR="6//"_$S($P($G(^MCAR(690.1,1,0)),U,7)="Y":"N",1:"Y"),DIC(0)="E" D ^DIE K DIE,DIC,DA,DR Q
104 D PARAM^MCU("6//"_$S($P($G(^MCAR(690.1,1,0)),U,7)="Y":"N",1:"Y"))
105 Q
106WLMGP ;Medicine Workload Mailgroup recipients
107 ;S DIE=690.1,DA=1,DR=7,DIC(0)="E" D ^DIE K DIC,DIE,DA,DR Q
108 D PARAM^MCU(7)
109 Q
110WLDEV ;Medicine Workload Print Device selection
111 ;S DIE=690.1,DA=1,DR=8,DIC(0)="E" D ^DIE K DIC,DIE,DA,DR Q
112 D PARAM^MCU(8)
113 Q
Note: See TracBrowser for help on using the repository browser.