Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCWORKLD

MCWORKLD.m

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