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

RGRSUTIL.m

Go to the documentation of this file.
  1. RGRSUTIL ;ALB/RJS-MPI/PD UTILITIES ;03/12/96
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19,45,57**;30 Apr 99;Build 2
  1. EXCEPT ;Members of the RG CIRN DEMOGRAPHIC ISSUES Mail Group are
  1. ;notified upon login if there are unresolved Primary View
  1. ;Reject exceptions for review in the MPI/PD Exception
  1. ;Handler ;**57 MPIC_1893 Only exception type 234 remains
  1. ;
  1. ;Is user a member of this mail group?
  1. S RGCDI=$$FIND1^DIC(3.8,,,"RG CIRN DEMOGRAPHIC ISSUES")
  1. I RGCDI="" G END
  1. S XMDUZ=DUZ,Y=RGCDI D CHK^XMA21 I '$T G END
  1. ;User is a member.
  1. I $O(^RGHL7(991.1,"ASTAT","0",234,0)) D
  1. .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
  1. .D SET^XUS1A("! << You have Primary View Reject exceptions that need to be reviewed using >>")
  1. .D SET^XUS1A("! << the MPI/PD Exception Handling Option on the Message Exception Menu. >>")
  1. .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
  1. END K RGCDI,XMDUZ,Y
  1. Q
  1. ;
  1. SEG(SEGMENT,PIECE,CODE) ;Return segment from RGDC array and kill node
  1. N RGNODE,RGDATA,RGDONE,RGC K RGDONE
  1. I '$D(RGC) S RGC=$E(HL("ECH"))
  1. S RGNODE=0
  1. F S RGNODE=$O(RGDC(RGNODE)) Q:RGNODE=""!($D(RGDONE)) D
  1. .S RGDATA=RGDC(RGNODE)
  1. .I ($P(RGDATA,HL("FS"),1)=SEGMENT)&($P($P(RGDATA,HL("FS"),PIECE),RGC,1)=CODE) S RGDONE=1 K RGDC(RGNODE)
  1. Q:$D(RGDONE) $G(RGDATA)
  1. Q ""
  1. SEG1(SEGMENT,PIECE,CODE) ;Return segment from RGDC array
  1. N RGNODE,RGDATA,RGDONE,RGC K RGDONE
  1. I '$D(RGC) S RGC=$E(HL("ECH"))
  1. S RGNODE=0
  1. F S RGNODE=$O(RGDC(RGNODE)) Q:RGNODE=""!($D(RGDONE)) D
  1. .S RGDATA=RGDC(RGNODE)
  1. .I ($P(RGDATA,HL("FS"),1)=SEGMENT)&($P($P(RGDATA,HL("FS"),PIECE),RGC,1)=CODE) S RGDONE=1
  1. Q:$D(RGDONE) $G(RGDATA)
  1. Q ""
  1. ERROR(CODE) ;**THIS ENTRY POINT IS NO LONGER USED**
  1. Q ""
  1. INITIZE ;Initialize RGDC array with incoming message
  1. N I,J,X
  1. F I=1:1 X HLNEXT Q:HLQUIT'>0 S RGDC(I)=HLNODE,J=0 F S J=$O(HLNODE(J)) Q:'J S RGDC(I,J)=HLNODE(J)
  1. Q
  1. SSNDFN(SSN) ;Input ssn output DFN
  1. N DFN
  1. Q:$G(SSN)="" -1
  1. S DFN=$O(^DPT("SSN",+SSN,0))
  1. Q:$L(DFN) DFN
  1. S DFN=$O(^DPT("SSN",SSN,0))
  1. Q:$L(DFN) DFN
  1. Q -1
  1. ;
  1. LINE() ; Return a dashed line.
  1. Q $TR($J("",80)," ","-")
  1. ;
  1. PAUSE() ; Pause for CRT output.
  1. ; Input: IOST, IOSL
  1. ; Output: 0 -- Continue to display output
  1. ; 1 -- Quit
  1. Q:$E(IOST,1,2)'["C-" 0
  1. N DIR,DIRUT,DTOUT,DUOUT,RGJ
  1. F RGJ=$Y:1:(IOSL-4) W !
  1. S DIR(0)="E" D ^DIR
  1. Q $D(DIRUT)!($D(DUOUT))
  1. ;
  1. DIAG(X) ; Return a string for diagnoses.
  1. ; Input: X - Code for type of diagnosis (Primary, etc.)
  1. ; Output: Descriptive string, i.e., "Primary", etc.
  1. Q $S($G(X)="":"Unknown",X="A":"Additional",X="P":"Primary",X="S":"Secondary",X="T":"Tertiary",1:"Unknown")
  1. ;
  1. ORD(X) ; Return a string for orders.
  1. ; Input: X - Code for type of order (Lab, etc.)
  1. ; Output: Descriptive string, i.e., "Lab", etc.
  1. Q $S($G(X)="":"Unknown",X="L":"Lab",X="R":"Radiology",1:"Unknown")
  1. ;
  1. UPDTFLD(FILE,FLD,ANS1,ANS2) ; Returns the correct field answer
  1. ;DLR - Added to prevent the overwriting the last four in ZIP with null
  1. ; input: FILE - file number (ex. 2 PATIENT)
  1. ; FLD - field number (ex. .1112 ZIP+4)
  1. ; ANS1 - existing field value
  1. ; ANS2 - incoming value
  1. I (FILE=2)&(FLD=.1112) I $E(ANS1,1,5)=$E(ANS2,1,5),($L(ANS2)=5) Q ANS1
  1. Q ANS2
  1. ;
  1. SSNINT(SSN) ;
  1. Q:$G(SSN)="" ""
  1. Q $TRANSLATE(SSN,"-","")
  1. ;
  1. ACTION ;Entry action for Primary View Reject exceptions
  1. I $O(^RGHL7(991.1,"ASTAT","0",234,0)) D
  1. .W !!," <<------------------------------------------------------------------------>>"
  1. .W !," << You have Primary View Reject exceptions that need to be reviewed using >>"
  1. .W !," << the MPI/PD Exception Handling Option on the Message Exception Menu. >>"
  1. .W !," <<------------------------------------------------------------------------>>"
  1. Q
  1. ;