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