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

RAO7MFN.m

Go to the documentation of this file. 
  1. RAO7MFN ;HISC/GJC-Create MFN orderable item update msg ;6/11/97  08:47
  1.  ;;5.0;Radiology/Nuclear Medicine;**1,6,10,18,45**;Mar 16, 1998
  1.  ;Last midification by SS for P18 JUN 19, 2000
  1.  ;Last modification: 12.16.03 patch 45 Contrast Media by CPT gjc
  1. PROC(RAENALL,RAFILE,RASTAT,RAY) ; Entry point to update a single procedure.
  1.  ; 'RAY'    <> is the same as 'Y' when passed back from DIC after
  1.  ;             lookup on file 71 & file 71.3
  1.  ; 'RAENALL'<> single procedure (0) or whole file update (1) flag
  1.  ; 'RAFILE' <> file # of the file being edited (71 or 71.3)
  1.  ; 'RASTAT' <> Procedure file (71) status: 0 inactive^1 active
  1.  ;             Com. Proc. file (71.3) Seq. # status: 0 inactive^1 active
  1.  ;             1st piece: status before edit, 2nd piece: status after
  1.  ;                        edit.
  1.  ; This entry point can be called from 2^RAMAIN2 or 13^RAMAIN2
  1.  ; This routine assumes that RAVAR is defined as an array or global
  1.  ;  root in which to place the output.
  1.  ;
  1.  Q:'$D(RAY)!('$D(RAFILE))!('$D(RASTAT))!('$D(RAENALL))
  1.  S RAFNUM=71,RAFNAME=$P($G(^DIC(RAFNUM,0)),"^"),RAXIT=0
  1.  S:'$D(RATSTMP) RATSTMP=$$NOW^XLFDT()
  1.  S:'$D(RACNT) RACNT=0 S:'$D(RAINCR) RAINCR="S RACNT=RACNT+1"
  1.  S:'$D(RASUB) RASUB="""RAO7"""
  1.  D:'$D(RAHLFS)!('$D(RAECH)) EN1^RAO7UTL
  1.  I 'RAENALL,('$D(RAVAR)) D
  1.  . S RAVAR="^TMP("_RASUB_","_RATSTMP_","
  1.  . S RAVARBLE="^TMP("_RASUB_","_RATSTMP_")"
  1.  . Q
  1.  I RAFILE=71 D
  1.  . S RA71(0)=$G(^RAMIS(RAFILE,+RAY,0))
  1.  . S RA71("I")=$G(^RAMIS(RAFILE,+RAY,"I"))
  1.  . I $D(^RAMIS(71.3,"B",+RAY)) D
  1.  .. S RA713(0)=$G(^RAMIS(71.3,+$O(^RAMIS(71.3,"B",+RAY,0)),0))
  1.  .. Q
  1.  . Q
  1.  I RAFILE=71.3 D
  1.  . S RA713(0)=$G(^RAMIS(RAFILE,+RAY,0))
  1.  . ; if RA713(0)="" then the common procedure was deleted
  1.  . S RASVIEN=$S(+RA713(0)>0:+RA713(0),1:+$P(RAY,"^",2))
  1.  . S RA71(0)=$G(^RAMIS(71,RASVIEN,0))
  1.  . S RA71("I")=$G(^RAMIS(71,RASVIEN,"I"))
  1.  . K RASVIEN
  1.  . Q
  1.  Q:$$PROCNDE^RAO7UTL(.RA71)  ; Does the Proc. have Proc-Types & I-Types
  1.  I RAFILE=71 D
  1.  .I +$P(RAY,"^",3) D
  1.  ..;new entry, add to master file whether active or inactive
  1.  ..S RAMFE="MAD"
  1.  ..Q
  1.  .I '+$P(RAY,"^",3),(+$P(RASTAT,"^",2)) D
  1.  ..;now active regardless of prior status, update master file
  1.  ..S RAMFE="MUP"
  1.  ..Q
  1.  .I '+$P(RAY,"^",3),('+$P(RASTAT,"^",2)) D
  1.  ..;now inactive regardless of prior status, deactivate master file
  1.  ..S RAMFE="MDC"
  1.  ..Q
  1.  .Q
  1.  ; If RAMFE is still not defined, must be an addition to common orders
  1.  ; 'Update' to OE since procedure is already in their master file
  1.  I RAFILE=71.3 S RAMFE="MUP"
  1.  ;
  1.  ; If parent with no descendents, send deactivate msg even if active
  1.  I $P($G(RA71(0)),"^",6)="P",'$O(^RAMIS(71,$S(RAFILE=71.3:+$P(RAY,"^",2),1:+RAY),4,0)) S RAMFE="MDC"
  1.  ;
  1.  S RACPT(0)=$$NAMCODE^RACPTMSC(+$P(RA71(0),"^",9),DT)
  1.  S:RAFILE=71 RAIEN71=+RAY S:RAFILE=71.3 RAIEN71=+$P(RAY,"^",2)
  1.  S RAXT71=$P(RA71(0),"^")
  1.  S RAIMGAB=$P($G(^RA(79.2,+$P(RA71(0),"^",12),0)),"^",3)
  1.  S RAPHYAP=$S($P(RA71(0),"^",11)="":"","Yy"[$P(RA71(0),"^",11):"Y",1:"N")
  1.  S RACOST=$P(RA71(0),"^",10),RAPRCTY=$P(RA71(0),"^",6)
  1.  S RACMNOR=$S($P($G(RA713(0)),"^",4)]"":"Y",1:"N") ;can't be an active common w/o a seq #
  1.  ;determine CM associations for active & inactive procedures
  1.  S RACMCODE=$$CMEDIA^RAO7UTL(RAIEN71,$P(RA71(0),U,6)) ;ien, proc. type
  1.  S RAINACT=$S(RA71("I")]"":$$HLDATE^HLFNC(RA71("I"),"DT"),1:"")
  1.  I 'RAENALL D
  1.  . X RAINCR
  1.  . S @(RAVAR_RACNT_")")=$$MSH^RAO7UTL("MFN^M01") X RAINCR ;P18 event type
  1.  . D MFI^RAO7UTL("UPD") ;P18
  1.  . Q
  1.  S @(RAVAR_RACNT_")")="MFE"_RAHLFS_RAMFE_RAHLFS_RAHLFS_RAINACT_RAHLFS
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_$P(RACPT(0),"^")
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_$P(RACPT(0),"^",2)
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_"CPT4"
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAIEN71
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAXT71
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_"99RAP"
  1.  K RAINACT X RAINCR
  1.  S @(RAVAR_RACNT_")")="ZRA"_RAHLFS_RAIMGAB_RAHLFS_RAPHYAP
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAHLFS_RACOST_RAHLFS
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_$G(RACMCODE)_RAHLFS
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RACMNOR_RAHLFS
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAPRCTY_RAHLFS
  1.  ; Check the synonym (1), message (3) and the Education Description
  1.  ; "EDU" multiples for data
  1.  N I,J,K,RAPMSG S RAPMSG=0
  1.  F RAMULT="^RAMIS(71,"_RAIEN71_",1,","^RAMIS(71,"_RAIEN71_",3,","^RAMIS(71,"_RAIEN71_",""EDU""," D
  1.  . I RAMULT=("^RAMIS(71,"_RAIEN71_",""EDU"","),($$UP^XLFSTR($P(RA71(0),"^",17))'="Y") Q  ; display Ed Descr not set to yes, quit
  1.  . Q:'+$O(@(RAMULT_"0)"))  ; no data for 1 synonym, 3 message, "EDU" desc multiple
  1.  . S (I,J)=0,K=""
  1.  . F  S J=$O(@(RAMULT_J_")")) Q:J'>0  D
  1.  .. S K=$G(@(RAMULT_J_",0)"))
  1.  .. I RAMULT=("^RAMIS(71,"_RAIEN71_",1,") D  Q
  1.  ... X RAINCR S I=I+1
  1.  ... S @(RAVAR_RACNT_")")="ZSY"_RAHLFS_I_RAHLFS_$P(K,"^")
  1.  ... Q
  1.  .. I RAMULT=("^RAMIS(71,"_RAIEN71_",3,") D
  1.  ... X RAINCR S I=I+1,RAPMSG=1
  1.  ... S @(RAVAR_RACNT_")")="NTE"_RAHLFS_I_RAHLFS_RAHLFS_$P($G(^RAMIS(71.4,+K,0)),"^")
  1.  ... Q
  1.  .. I RAMULT=("^RAMIS(71,"_RAIEN71_",""EDU"",") D
  1.  ... I RAPMSG D
  1.  .... X RAINCR S I=I+1
  1.  .... S @(RAVAR_RACNT_")")="NTE"_RAHLFS_I_RAHLFS_RAHLFS_" "
  1.  .... S RAPMSG=0
  1.  .... Q
  1.  ... X RAINCR S I=I+1
  1.  ... S @(RAVAR_RACNT_")")="NTE"_RAHLFS_I_RAHLFS_RAHLFS_K
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  I 'RAENALL D
  1.  . D MSG^XQOR("RA ORDERABLE ITEM UPDATE",RAVARBLE)
  1.  . D PURGE^RAO7UTL
  1.  . Q
  1.  X:RAENALL RAINCR
  1.  Q
  1. ENALL ; Whole Rad/Nuc Med Procedure file update.  Called only when Rad/Nuc
  1.  ; Med or OE/RR are being installed.
  1.  Q:'$D(XPDNM)  ; quit if not KIDS, xists during pre/post inits
  1.  ; & environment check routines.
  1.  L +^RAMIS(71.3):300 D ^RACOMDEL L -^RAMIS(71.3)
  1.  L +^RAMIS(71):300
  1.  I '$T D  Q
  1.  . N TXT S TXT(1)=" "
  1.  . S TXT(2)="Another user is editing a record in the "
  1.  . S TXT(2)=TXT(2)_$P($G(^DIC(71,0)),"^")
  1.  . S TXT(3)="file.  Try again later!"
  1.  . S XPDQUIT=1 D MES^XPDUTL(.TXT)
  1.  . Q
  1.  N RA,RACNT,RAECH,RAENALL,RAFILE,RAFNAME,RAFNUM,RAHLFS,RAINCR,RASTAT
  1.  N RASUB,RATSTMP,RAVAR,RAXIT,RAY
  1.  S (RA,RACNT)=0,RAENALL=1,RATSTMP=$$NOW^XLFDT(),RAINCR="S RACNT=RACNT+1"
  1.  S RASUB="""RAO7""",RAVAR="^TMP("_RASUB_","_RATSTMP_","
  1.  S RAVARBLE="^TMP("_RASUB_","_RATSTMP_")"
  1.  D EN1^RAO7UTL ; sets up RAECH & RAHLFS
  1.  S (RAFILE,RAFNUM)=71,RAFNAME=$P($G(^DIC(RAFNUM,0)),"^"),RASTAT="0^1"
  1.  X RAINCR S @(RAVAR_RACNT_")")=$$MSH^RAO7UTL("MFN^M01") X RAINCR ;P18 event type
  1.  D MFI^RAO7UTL("REP")
  1.  F  S RA=$O(^RAMIS(71,RA)) Q:RA'>0  D  D PURGE1^RAO7UTL
  1.  . S RA(0)=$G(^RAMIS(71,RA,0)),RA("I")=$G(^RAMIS(71,RA,"I"))
  1.  . Q:$P(RA("I"),"^")]""&($P(RA("I"),"^")'>DT)  ; inactive date present
  1.  . S RAY=RA_"^"_$P(RA(0),"^")_"^"_1 D PROC(RAENALL,RAFILE,RASTAT,RAY)
  1.  . Q
  1.  D EN^ORMFN(RAVARBLE) K @RAVARBLE,RAVARBLE
  1.  L -^RAMIS(71) ; unlock whole file
  1. PARM ;Send Div params for SUBMIT TO prompt and allowing BROAD procedures
  1.  ;to OE3 so they can populate their OE/RR Parameter Instance file
  1.  N DIK S DIK="^RA(79,",DIK(1)=".121^AC1" D ENALL^DIK
  1.  N DIK S DIK="^RA(79,",DIK(1)=".17^AC" D ENALL^DIK
  1.  Q