| [613] | 1 | RGRSUTIL ;ALB/RJS-MPI/PD UTILITIES ;03/12/96
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19,45**;30 Apr 99;Build 9
|
|---|
| 3 | ;
|
|---|
| 4 | EXCEPT ;Members of the RG CIRN DEMOGRAPHIC ISSUES Mail Group are
|
|---|
| 5 | ;notified upon login if there are unresolved exceptions in
|
|---|
| 6 | ;the MPI/PD Exception Handler or if there are Primary View
|
|---|
| 7 | ;Reject exceptions for review.
|
|---|
| 8 | ;
|
|---|
| 9 | ;Is user a member of this mail group?
|
|---|
| 10 | S RGCDI=$$FIND1^DIC(3.8,,,"RG CIRN DEMOGRAPHIC ISSUES")
|
|---|
| 11 | I RGCDI="" G END
|
|---|
| 12 | S XMDUZ=DUZ,Y=RGCDI D CHK^XMA21 I '$T G END
|
|---|
| 13 | ;User is a member.
|
|---|
| 14 | S RGNOTFY=$$CUREX^RGEX01()
|
|---|
| 15 | I (RGNOTFY=1)!(RGNOTFY=3) D
|
|---|
| 16 | .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
|
|---|
| 17 | .D SET^XUS1A("! << Use the MPI/PD Exception Handling option on the Message Exception >>")
|
|---|
| 18 | .D SET^XUS1A("! << Menu to resolve exceptions. >>")
|
|---|
| 19 | .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
|
|---|
| 20 | I (RGNOTFY=2)!(RGNOTFY=3) D
|
|---|
| 21 | .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
|
|---|
| 22 | .D SET^XUS1A("! << You have Primary View Reject exceptions that need to be reviewed using >>")
|
|---|
| 23 | .D SET^XUS1A("! << the MPI/PD Exception Handling Option on the Message Exception Menu. >>")
|
|---|
| 24 | .D SET^XUS1A("! <<------------------------------------------------------------------------>>")
|
|---|
| 25 | END K RGCDI,RGNOTFY,XMDUZ,Y
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | SEG(SEGMENT,PIECE,CODE) ;Return segment from RGDC array and kill node
|
|---|
| 29 | N RGNODE,RGDATA,RGDONE,RGC K RGDONE
|
|---|
| 30 | I '$D(RGC) S RGC=$E(HL("ECH"))
|
|---|
| 31 | S RGNODE=0
|
|---|
| 32 | F S RGNODE=$O(RGDC(RGNODE)) Q:RGNODE=""!($D(RGDONE)) D
|
|---|
| 33 | .S RGDATA=RGDC(RGNODE)
|
|---|
| 34 | .I ($P(RGDATA,HL("FS"),1)=SEGMENT)&($P($P(RGDATA,HL("FS"),PIECE),RGC,1)=CODE) S RGDONE=1 K RGDC(RGNODE)
|
|---|
| 35 | Q:$D(RGDONE) $G(RGDATA)
|
|---|
| 36 | Q ""
|
|---|
| 37 | SEG1(SEGMENT,PIECE,CODE) ;Return segment from RGDC array
|
|---|
| 38 | N RGNODE,RGDATA,RGDONE,RGC K RGDONE
|
|---|
| 39 | I '$D(RGC) S RGC=$E(HL("ECH"))
|
|---|
| 40 | S RGNODE=0
|
|---|
| 41 | F S RGNODE=$O(RGDC(RGNODE)) Q:RGNODE=""!($D(RGDONE)) D
|
|---|
| 42 | .S RGDATA=RGDC(RGNODE)
|
|---|
| 43 | .I ($P(RGDATA,HL("FS"),1)=SEGMENT)&($P($P(RGDATA,HL("FS"),PIECE),RGC,1)=CODE) S RGDONE=1
|
|---|
| 44 | Q:$D(RGDONE) $G(RGDATA)
|
|---|
| 45 | Q ""
|
|---|
| 46 | ERROR(CODE) ;**THIS ENTRY POINT IS NO LONGER USED**
|
|---|
| 47 | Q ""
|
|---|
| 48 | INITIZE ;Initialize RGDC array with incoming message
|
|---|
| 49 | N I,J,X
|
|---|
| 50 | 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)
|
|---|
| 51 | Q
|
|---|
| 52 | SSNDFN(SSN) ;Input ssn output DFN
|
|---|
| 53 | N DFN
|
|---|
| 54 | Q:$G(SSN)="" -1
|
|---|
| 55 | S DFN=$O(^DPT("SSN",+SSN,0))
|
|---|
| 56 | Q:$L(DFN) DFN
|
|---|
| 57 | S DFN=$O(^DPT("SSN",SSN,0))
|
|---|
| 58 | Q:$L(DFN) DFN
|
|---|
| 59 | Q -1
|
|---|
| 60 | ;
|
|---|
| 61 | LINE() ; Return a dashed line.
|
|---|
| 62 | Q $TR($J("",80)," ","-")
|
|---|
| 63 | ;
|
|---|
| 64 | PAUSE() ; Pause for CRT output.
|
|---|
| 65 | ; Input: IOST, IOSL
|
|---|
| 66 | ; Output: 0 -- Continue to display output
|
|---|
| 67 | ; 1 -- Quit
|
|---|
| 68 | Q:$E(IOST,1,2)'["C-" 0
|
|---|
| 69 | N DIR,DIRUT,DTOUT,DUOUT,RGJ
|
|---|
| 70 | F RGJ=$Y:1:(IOSL-4) W !
|
|---|
| 71 | S DIR(0)="E" D ^DIR
|
|---|
| 72 | Q $D(DIRUT)!($D(DUOUT))
|
|---|
| 73 | ;
|
|---|
| 74 | DIAG(X) ; Return a string for diagnoses.
|
|---|
| 75 | ; Input: X - Code for type of diagnosis (Primary, etc.)
|
|---|
| 76 | ; Output: Descriptive string, i.e., "Primary", etc.
|
|---|
| 77 | Q $S($G(X)="":"Unknown",X="A":"Additional",X="P":"Primary",X="S":"Secondary",X="T":"Tertiary",1:"Unknown")
|
|---|
| 78 | ;
|
|---|
| 79 | ORD(X) ; Return a string for orders.
|
|---|
| 80 | ; Input: X - Code for type of order (Lab, etc.)
|
|---|
| 81 | ; Output: Descriptive string, i.e., "Lab", etc.
|
|---|
| 82 | Q $S($G(X)="":"Unknown",X="L":"Lab",X="R":"Radiology",1:"Unknown")
|
|---|
| 83 | ;
|
|---|
| 84 | UPDTFLD(FILE,FLD,ANS1,ANS2) ; Returns the correct field answer
|
|---|
| 85 | ;DLR - Added to prevent the overwriting the last four in ZIP with null
|
|---|
| 86 | ; input: FILE - file number (ex. 2 PATIENT)
|
|---|
| 87 | ; FLD - field number (ex. .1112 ZIP+4)
|
|---|
| 88 | ; ANS1 - existing field value
|
|---|
| 89 | ; ANS2 - incoming value
|
|---|
| 90 | I (FILE=2)&(FLD=.1112) I $E(ANS1,1,5)=$E(ANS2,1,5),($L(ANS2)=5) Q ANS1
|
|---|
| 91 | Q ANS2
|
|---|
| 92 | ;
|
|---|
| 93 | SSNINT(SSN) ;
|
|---|
| 94 | Q:$G(SSN)="" ""
|
|---|
| 95 | Q $TRANSLATE(SSN,"-","")
|
|---|
| 96 | ;
|
|---|
| 97 | ACTION ;Entry action for Primary View Reject exceptions
|
|---|
| 98 | I $O(^RGHL7(991.1,"ASTAT","0",234,0)) D
|
|---|
| 99 | .W !!," <<------------------------------------------------------------------------>>"
|
|---|
| 100 | .W !," << You have Primary View Reject exceptions that need to be reviewed using >>"
|
|---|
| 101 | .W !," << the MPI/PD Exception Handling Option on the Message Exception Menu. >>"
|
|---|
| 102 | .W !," <<------------------------------------------------------------------------>>"
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
