114 lines
4.0 KiB
Mathematica
114 lines
4.0 KiB
Mathematica
MCWORKLD ;WISC/RMP-Workload reporting ;4/8/97 07:47
|
|
;;2.3;Medicine;**8**;09/13/1996
|
|
;Routine which delivers a Mail message to the
|
|
;specified Device(s) and Mailgroup(s) when a procedure
|
|
;with an assigned CPT code has been released with a signature
|
|
;
|
|
N CNT,DEVICE,MAILGRP,ARRAY
|
|
Q:$P($G(^MCAR(690.1,1,0)),U,7)'="Y" ;Check Workload toggle
|
|
Q:'($D(^MCAR(MCFILE,MCARGDA,0))#2) ;Check o node for G.P. patch
|
|
Q:$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,7)["S" ;Don't send a message
|
|
;for a superceded record
|
|
D TEXT(MCFILE,MCARGDA,.ARRAY) ;Check for completeness
|
|
Q:'$D(ARRAY)
|
|
;Device/Mailgroup parameter loading
|
|
I $D(^MCAR(690.1,1,1,0)) D
|
|
.S CNT=0
|
|
.F S CNT=$O(^MCAR(690.1,1,2,CNT)) Q:CNT'?1N.N D
|
|
..Q:'$D(^MCAR(690.1,1,2,CNT,0))
|
|
..N MCARCNT S MCARCNT=^MCAR(690.1,1,2,CNT,0)
|
|
..S DEVICE(CNT)=$P(^%ZIS(1,MCARCNT,0),U)
|
|
..Q
|
|
.Q
|
|
I $D(^MCAR(690.1,1,2,0)) D
|
|
.S CNT=0
|
|
.F S CNT=$O(^MCAR(690.1,1,1,CNT)) Q:CNT'?1N.N D
|
|
..Q:'$D(^MCAR(690.1,1,1,CNT,0))
|
|
..N MCARCNT S MCARCNT=^MCAR(690.1,1,1,CNT,0)
|
|
..S MAILGRP(CNT)=$P(^XMB(3.8,MCARCNT,0),U)
|
|
..Q
|
|
.Q
|
|
;Q:($G(DEVICE(1))=0)&($G(MAILGRP(1))=0)
|
|
Q:($D(DEVICE)=0)&($D(MAILGRP)=0)
|
|
; Mailman parameters
|
|
S XMSUB="Completed Coded Medicine Procedure"
|
|
S XMTEXT="ARRAY(",XMDUZ=DUZ,XMCHAN=""
|
|
S CNT=0 F S CNT=$O(DEVICE(CNT)) Q:CNT="" S XMY("D."_DEVICE(CNT))=""
|
|
S CNT=0 F S CNT=$O(MAILGRP(CNT)) Q:CNT="" S XMY("G."_MAILGRP(CNT))=""
|
|
D ^XMD
|
|
D KILL^XM
|
|
Q
|
|
;
|
|
TEXT(MCFILE,MCARGDA,ARRAY) ;
|
|
;Report variables:
|
|
;DFN -- Patient ID, pointer to the Patient file (2)
|
|
;PRID -- Provider ID, DUZ or pointer to the New Person file (200)
|
|
;PRNAME -- Provider Name
|
|
;PDATET -- Procedure Date/Time, DATE SIGNED
|
|
;CPT -- CPT code, Code associated throught the Procedure Term file
|
|
N PTMP,PRNAME,CPT,MCDATET,SSN
|
|
K ARRAY
|
|
S PRID=$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,4)
|
|
S FMDT=$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,6),Y=FMDT
|
|
S DFN=$$DFN(MCFILE,MCARGDA)
|
|
S CPT=$$CPT(MCFILE,MCARGDA)
|
|
I (PRID="")!(FMDT="")!(DFN="")!(CPT="") Q
|
|
D DD^%DT S MCDATET=Y
|
|
; ------------------------
|
|
; SSN = Enternal Format of the patients SSN.
|
|
; ------------------------
|
|
D DEM^VADPT S MCARNM=VADM(1),SSN=$P(VADM(2),U,2) D KVAR^VADPT
|
|
S PTMP=$P(^VA(200,PRID,0),U),PRNAME=$P(PTMP,",",2)_" "_$P(PTMP,",")
|
|
S ARRAY(1)="Patient: "_MCARNM
|
|
S ARRAY(2)="SSN: "_SSN
|
|
S ARRAY(3)="Procedure: "_CPT
|
|
S ARRAY(4)="Date/Time: "_MCDATET
|
|
S ARRAY(5)="Provider: "_PRNAME
|
|
Q
|
|
;
|
|
CPT(FILE,DA) ;
|
|
N TEMP,IEN,CPT,PRO
|
|
S CPT=""
|
|
S MCARP=$O(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0))
|
|
S IEN=$O(^MCAR(694.8,"PS",MCARP,0))
|
|
;Q:IEN=""
|
|
I IEN]"",$D(^MCAR(694.8,IEN,1,0)) S TEMP=0,PRO=$P($G(^MCAR(694.8,IEN,0)),U) D
|
|
.F Q:CPT?1N.N S TEMP=$O(^MCAR(694.8,IEN,1,TEMP)) Q:TEMP'?1N.N D
|
|
..I $P($P(^(TEMP,0),U),";",2)["ICPT(" S CPT=$P($P(^(0),U),";")
|
|
..Q
|
|
.S CPT=PRO_" "_CPT ;V2.3, E3R 8219, JCC, 5/13/96
|
|
Q CPT
|
|
;
|
|
DFN(FILE,DA) ;
|
|
N TEMP
|
|
;S TEMP=$P(^DD(FILE,$$PATFLD(FILE,DA),0),U,4)
|
|
S TEMP=$$GET1^DID(FILE,$$PATFLD(FILE,DA),"","GLOBAL SUBSCRIPT LOCATION")
|
|
Q $P($G(^MCAR(FILE,MCARGDA,$P(TEMP,";"))),U,$P(TEMP,";",2))
|
|
;V2.3, FIX UNDEF, JCC, 5/21/96
|
|
PATFLD(FILE,DA) ;
|
|
N TEMP
|
|
S TEMP=$G(^MCAR(697.2,$O(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0)),0))
|
|
Q $P(TEMP,U,12)
|
|
MCPRO(MCFILE,MCARGDA) ;694(0;3),699(0;12),699.5(0;6)
|
|
;HAVE MULTIPLE FILE 697.2 ENTRIES
|
|
I (MCFILE=694)!(MCFILE=699)!(MCFILE=699.5) Q $$MCP(MCFILE,MCARGDA) ;V2.3, CHGED SECOND 699 TO 699.5, JCC, 6/17/96
|
|
Q $P(^MCAR(697.2,$O(^MCAR(697.2,"C","MCAR("_MCFILE,0)),0),U)
|
|
MCP(MCFILE,MCARGDA) ;
|
|
Q $P(^MCAR(697.2,$P($G(^MCAR(MCFILE,MCARGDA,$$NODE(MCFILE))),U,$$PIECE(MCFILE)),0),U)
|
|
NODE(MCFILE) ;
|
|
Q $S(1:0) ;694&699&699.5 use the 0 node
|
|
PIECE(MCFILE) ;
|
|
Q $S(MCFILE=694:3,MCFILE=699:12,MCFILE=699.5:6,1:0)
|
|
WLTOG ;Medicine Workload reporting Toggle
|
|
;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
|
|
D PARAM^MCU("6//"_$S($P($G(^MCAR(690.1,1,0)),U,7)="Y":"N",1:"Y"))
|
|
Q
|
|
WLMGP ;Medicine Workload Mailgroup recipients
|
|
;S DIE=690.1,DA=1,DR=7,DIC(0)="E" D ^DIE K DIC,DIE,DA,DR Q
|
|
D PARAM^MCU(7)
|
|
Q
|
|
WLDEV ;Medicine Workload Print Device selection
|
|
;S DIE=690.1,DA=1,DR=8,DIC(0)="E" D ^DIE K DIC,DIE,DA,DR Q
|
|
D PARAM^MCU(8)
|
|
Q
|