- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCWORKLD 4231 printed Feb 18, 2025@23:43:24 Page 2
- MCWORKLD ;WISC/RMP-Workload reporting ;4/8/97 07:47
- +1 ;;2.3;Medicine;**8**;09/13/1996
- +2 ;Routine which delivers a Mail message to the
- +3 ;specified Device(s) and Mailgroup(s) when a procedure
- +4 ;with an assigned CPT code has been released with a signature
- +5 ;
- +6 NEW CNT,DEVICE,MAILGRP,ARRAY
- +7 ;Check Workload toggle
- if $PIECE($GET(^MCAR(690.1,1,0)),U,7)'="Y"
- QUIT
- +8 ;Check o node for G.P. patch
- if '($DATA(^MCAR(MCFILE,MCARGDA,0))#2)
- QUIT
- +9 ;Don't send a message
- if $PIECE($GET(^MCAR(MCFILE,MCARGDA,"ES")),U,7)["S"
- QUIT
- +10 ;for a superceded record
- +11 ;Check for completeness
- DO TEXT(MCFILE,MCARGDA,.ARRAY)
- +12 if '$DATA(ARRAY)
- QUIT
- +13 ;Device/Mailgroup parameter loading
- +14 IF $DATA(^MCAR(690.1,1,1,0))
- Begin DoDot:1
- +15 SET CNT=0
- +16 FOR
- SET CNT=$ORDER(^MCAR(690.1,1,2,CNT))
- if CNT'?1N.N
- QUIT
- Begin DoDot:2
- +17 if '$DATA(^MCAR(690.1,1,2,CNT,0))
- QUIT
- +18 NEW MCARCNT
- SET MCARCNT=^MCAR(690.1,1,2,CNT,0)
- +19 SET DEVICE(CNT)=$PIECE(^%ZIS(1,MCARCNT,0),U)
- +20 QUIT
- End DoDot:2
- +21 QUIT
- End DoDot:1
- +22 IF $DATA(^MCAR(690.1,1,2,0))
- Begin DoDot:1
- +23 SET CNT=0
- +24 FOR
- SET CNT=$ORDER(^MCAR(690.1,1,1,CNT))
- if CNT'?1N.N
- QUIT
- Begin DoDot:2
- +25 if '$DATA(^MCAR(690.1,1,1,CNT,0))
- QUIT
- +26 NEW MCARCNT
- SET MCARCNT=^MCAR(690.1,1,1,CNT,0)
- +27 SET MAILGRP(CNT)=$PIECE(^XMB(3.8,MCARCNT,0),U)
- +28 QUIT
- End DoDot:2
- +29 QUIT
- End DoDot:1
- +30 ;Q:($G(DEVICE(1))=0)&($G(MAILGRP(1))=0)
- +31 if ($DATA(DEVICE)=0)&($DATA(MAILGRP)=0)
- QUIT
- +32 ; Mailman parameters
- +33 SET XMSUB="Completed Coded Medicine Procedure"
- +34 SET XMTEXT="ARRAY("
- SET XMDUZ=DUZ
- SET XMCHAN=""
- +35 SET CNT=0
- FOR
- SET CNT=$ORDER(DEVICE(CNT))
- if CNT=""
- QUIT
- SET XMY("D."_DEVICE(CNT))=""
- +36 SET CNT=0
- FOR
- SET CNT=$ORDER(MAILGRP(CNT))
- if CNT=""
- QUIT
- SET XMY("G."_MAILGRP(CNT))=""
- +37 DO ^XMD
- +38 DO KILL^XM
- +39 QUIT
- +40 ;
- TEXT(MCFILE,MCARGDA,ARRAY) ;
- +1 ;Report variables:
- +2 ;DFN -- Patient ID, pointer to the Patient file (2)
- +3 ;PRID -- Provider ID, DUZ or pointer to the New Person file (200)
- +4 ;PRNAME -- Provider Name
- +5 ;PDATET -- Procedure Date/Time, DATE SIGNED
- +6 ;CPT -- CPT code, Code associated throught the Procedure Term file
- +7 NEW PTMP,PRNAME,CPT,MCDATET,SSN
- +8 KILL ARRAY
- +9 SET PRID=$PIECE($GET(^MCAR(MCFILE,MCARGDA,"ES")),U,4)
- +10 SET FMDT=$PIECE($GET(^MCAR(MCFILE,MCARGDA,"ES")),U,6)
- SET Y=FMDT
- +11 SET DFN=$$DFN(MCFILE,MCARGDA)
- +12 SET CPT=$$CPT(MCFILE,MCARGDA)
- +13 IF (PRID="")!(FMDT="")!(DFN="")!(CPT="")
- QUIT
- +14 DO DD^%DT
- SET MCDATET=Y
- +15 ; ------------------------
- +16 ; SSN = Enternal Format of the patients SSN.
- +17 ; ------------------------
- +18 DO DEM^VADPT
- SET MCARNM=VADM(1)
- SET SSN=$PIECE(VADM(2),U,2)
- DO KVAR^VADPT
- +19 SET PTMP=$PIECE(^VA(200,PRID,0),U)
- SET PRNAME=$PIECE(PTMP,",",2)_" "_$PIECE(PTMP,",")
- +20 SET ARRAY(1)="Patient: "_MCARNM
- +21 SET ARRAY(2)="SSN: "_SSN
- +22 SET ARRAY(3)="Procedure: "_CPT
- +23 SET ARRAY(4)="Date/Time: "_MCDATET
- +24 SET ARRAY(5)="Provider: "_PRNAME
- +25 QUIT
- +26 ;
- CPT(FILE,DA) ;
- +1 NEW TEMP,IEN,CPT,PRO
- +2 SET CPT=""
- +3 SET MCARP=$ORDER(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0))
- +4 SET IEN=$ORDER(^MCAR(694.8,"PS",MCARP,0))
- +5 ;Q:IEN=""
- +6 IF IEN]""
- IF $DATA(^MCAR(694.8,IEN,1,0))
- SET TEMP=0
- SET PRO=$PIECE($GET(^MCAR(694.8,IEN,0)),U)
- Begin DoDot:1
- +7 FOR
- if CPT?1N.N
- QUIT
- SET TEMP=$ORDER(^MCAR(694.8,IEN,1,TEMP))
- if TEMP'?1N.N
- QUIT
- Begin DoDot:2
- +8 IF $PIECE($PIECE(^(TEMP,0),U),";",2)["ICPT("
- SET CPT=$PIECE($PIECE(^(0),U),";")
- +9 QUIT
- End DoDot:2
- +10 ;V2.3, E3R 8219, JCC, 5/13/96
- SET CPT=PRO_" "_CPT
- End DoDot:1
- +11 QUIT CPT
- +12 ;
- DFN(FILE,DA) ;
- +1 NEW TEMP
- +2 ;S TEMP=$P(^DD(FILE,$$PATFLD(FILE,DA),0),U,4)
- +3 SET TEMP=$$GET1^DID(FILE,$$PATFLD(FILE,DA),"","GLOBAL SUBSCRIPT LOCATION")
- +4 QUIT $PIECE($GET(^MCAR(FILE,MCARGDA,$PIECE(TEMP,";"))),U,$PIECE(TEMP,";",2))
- +5 ;V2.3, FIX UNDEF, JCC, 5/21/96
- PATFLD(FILE,DA) ;
- +1 NEW TEMP
- +2 SET TEMP=$GET(^MCAR(697.2,$ORDER(^MCAR(697.2,"B",$$MCPRO(FILE,DA),0)),0))
- +3 QUIT $PIECE(TEMP,U,12)
- MCPRO(MCFILE,MCARGDA) ;694(0;3),699(0;12),699.5(0;6)
- +1 ;HAVE MULTIPLE FILE 697.2 ENTRIES
- +2 ;V2.3, CHGED SECOND 699 TO 699.5, JCC, 6/17/96
- IF (MCFILE=694)!(MCFILE=699)!(MCFILE=699.5)
- QUIT $$MCP(MCFILE,MCARGDA)
- +3 QUIT $PIECE(^MCAR(697.2,$ORDER(^MCAR(697.2,"C","MCAR("_MCFILE,0)),0),U)
- MCP(MCFILE,MCARGDA) ;
- +1 QUIT $PIECE(^MCAR(697.2,$PIECE($GET(^MCAR(MCFILE,MCARGDA,$$NODE(MCFILE))),U,$$PIECE(MCFILE)),0),U)
- NODE(MCFILE) ;
- +1 ;694&699&699.5 use the 0 node
- QUIT $SELECT(1:0)
- PIECE(MCFILE) ;
- +1 QUIT $SELECT(MCFILE=694:3,MCFILE=699:12,MCFILE=699.5:6,1:0)
- 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
- +2 DO PARAM^MCU("6//"_$SELECT($PIECE($GET(^MCAR(690.1,1,0)),U,7)="Y":"N",1:"Y"))
- +3 QUIT
- 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
- +2 DO PARAM^MCU(7)
- +3 QUIT
- 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
- +2 DO PARAM^MCU(8)
- +3 QUIT