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

RAHLEX1.m

Go to the documentation of this file.
  1. RAHLEX1 ;HIRMFO/REL,CRT - RAD/NUC MED HL7 Voice Reporting Exception Protocols ; 02/02/99
  1. ;;5.0;Radiology/Nuclear Medicine;**12**;Mar 16, 1998
  1. ; Last Edited by CRT
  1. ;
  1. Q
  1. EN ; Print Exception List Protocol - Called from ListMan ONLY
  1. ;
  1. D CLEAR^VALM1
  1. ;
  1. DEVICE ; Select device to print report
  1. ;
  1. S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Select Device: "
  1. D ^%ZIS K %ZIS I POP K DTOUT,DUOUT,POP G END
  1. ;
  1. I '$D(IO("Q")) G PRINT
  1. ;
  1. S ZTRTN="PRINT^RAHLEX1"
  1. S ZTDESC="Rad/Nuc Med HL7 Voice Reprting Errors List."
  1. ;
  1. S ZTSAVE("RAHL7SDT")=""
  1. S ZTSAVE("RAHL7EDT")=""
  1. S ZTSAVE("^TMP($J,""RAHLAPP"",")=""
  1. S ZTSAVE("^TMP($J,""RAHLUSR"",")=""
  1. ;S ZTSAVE("^TMP($J,""RAHLSRT"",")="" ; Causes Subscript error !?!?!?!
  1. ;
  1. D ^%ZTLOAD
  1. I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: "_$G(ZTSK)
  1. I +$G(ZTSK("D"))=0 W !?5,"Request Cancelled"
  1. H 1.5
  1. D ^%ZISC,HOME^%ZIS K %X,%Y,%XX,%YY,IO("Q")
  1. G END
  1. ;
  1. PRINT ; Start printing the report to the requested device - using ^TMP
  1. ; RAPN = Page Number
  1. ; WAIT = "^" if user has requested to quit prematurely
  1. ;
  1. I $D(ZTQUEUED) D
  1. .S ZTREQ="@"
  1. .S RAHLSRT="^TMP($J,""RAHLSRT"")"
  1. .S RAHLUSR="^TMP($J,""RAHLUSR"")"
  1. .S RAHLAPP="^TMP($J,""RAHLAPP"")"
  1. S WAIT="",RAPN=0,RAPL=0
  1. I '$D(@RAHLSRT) D SETTMP^RAHLEX
  1. ;
  1. U IO
  1. ;
  1. S RASEND="" F S RASEND=$O(@RAHLSRT@(RASEND)) Q:(RASEND="")!(WAIT="^") D
  1. .S RAPN=RAPN+1 D:RAPN'=1 WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
  1. .S RADATE="" F S RADATE=$O(@RAHLSRT@(RASEND,RADATE)) Q:(RADATE="")!(WAIT="^") D
  1. ..S RADPT="" F S RADPT=$O(@RAHLSRT@(RASEND,RADATE,RADPT)) Q:(RADPT="")!(WAIT="^") D
  1. ...S RACN="" F S RACN=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN)) Q:(RACN="")!(WAIT="^") D
  1. ....S RAUSER="" F S RAUSER=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER)) Q:(RAUSER="")!(WAIT="^") D
  1. .....I $Y+5>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
  1. .....S RAEXCP=@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER,"ERR")
  1. .....I $D(ZTQUEUED) D STOPCHK^RAUTL9 I $G(ZTSTOP)=1 S WAIT="^" Q
  1. .....D FORMAT^RAHLEX1
  1. ;
  1. I $Y+3>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 G END:WAIT="^" D HEADER^RAHLEX1
  1. D EN^DDIOL("** End of Report **","","!?19")
  1. D EN^DDIOL("","","!")
  1. D WAIT^RAHLEX1
  1. ;
  1. END ;
  1. I $D(ZTQUEUED) D
  1. .K @RAHLSRT,RAHLSRT,@RAHLUSR,RAHLUSR,@RAHLAPP,RAHLAPP
  1. K X,Y,NOW,%,RASEND,RAUSER,RADATE,RADPT,RACN,RAEXCP,RAPN,RAPL
  1. K DTOUT,DUOUT,ZTRTN,ZTDESC,ZTSAVE,ZTSK,WAIT,ZTSTOP
  1. D CLOSE^RAUTL
  1. D HOME^%ZIS
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. WAIT ; Prompt user to hit RETURN for next page
  1. ;
  1. I $E(IOST,1,2)'="C-" S WAIT="" Q ; Don't prompt if report queued
  1. ;
  1. S DIR(0)="E"
  1. S (DIR("?"),DIR("??"))=""
  1. D ^DIR K DIR
  1. I Y=""!(Y=0) S WAIT="^"
  1. Q
  1. ;
  1. ;
  1. K RAHDR
  1. I '($D(ZTQUEUED)&(RAPN=1)) W @IOF
  1. S RAHDR(1)=$$REPEAT^XLFSTR("=",80)
  1. S RAHDR(1,"F")=""
  1. D NOW^%DTC,YX^%DTC S NOW="Printed: "_$P(Y,"@")_" "_$E($P(Y,"@",2),1,5)
  1. S TITLE="HL7 Voice Reporting Errors "
  1. S PAGE="Page: "_RAPN
  1. S RAHDR(2)=TITLE
  1. S RAHDR(2,"F")="!?1" ; Left Justified
  1. S RAHDR(3)=PAGE
  1. S RAHDR(3,"F")="?"_(78-$L(PAGE)) ; Right Justified
  1. S TITLE="("_RASEND_" - RADIOLOGY/NUCLEAR MEDICINE)"
  1. S RAHDR(4)=TITLE
  1. S RAHDR(4,"F")="!?1" ; Left Justified
  1. S RAHDR(5)=NOW
  1. S RAHDR(5,"F")="?"_(78-$L(NOW)) ; Right Justified
  1. S RAHDR(6)=$$REPEAT^XLFSTR("=",78)
  1. S RAHDR(6,"F")="!?1"
  1. S RAHDR(7)=""
  1. D EN^DDIOL(.RAHDR)
  1. K RAHDR,PAGE,TITLE,NOW
  1. Q
  1. ;
  1. FORMAT ; Format of Report
  1. ;
  1. K RADSP
  1. D DISDATE^RAHLEX(" at ")
  1. S RADSP(1)="Exception Date: "_XRADATE
  1. S RADSP(1,"F")="!?1"
  1. S RADSP(2)="User: "_$E(RAUSER,1,24)
  1. S RADSP(2,"F")="?50"
  1. S RADSP(3)="Patient Name: "_RADPT
  1. S RADSP(3,"F")="!?1"
  1. S RADSP(4)="Case: "_RACN
  1. S RADSP(4,"F")="?50"
  1. S RADSP(5)="Reason Rejected: "_RAEXCP
  1. S RADSP(5,"F")="!?1"
  1. S RADSP(6)=""
  1. D EN^DDIOL(.RADSP)
  1. K RADSP,XRADATE
  1. Q
  1. ;
  1. ; =================================================================
  1. ;
  1. NXTAPP(DIR) ; Next or Previous Exception Protocol
  1. ; VALMLST = Last ListMan Line Displayed
  1. ; VALMBG = First ListMan Line Displayed
  1. ;
  1. S DIR=$G(DIR)
  1. S VALMBCK=""
  1. I DIR=1 D G NEND ; Next Exception forward
  1. .S RALINE=VALMLST
  1. .I '$D(@RAHLSEL@(RALINE)) D
  1. ..S RALINE=$O(@RAHLSEL@(RALINE))
  1. ..S:RALINE="" RALINE=VALMLST
  1. .S RALINE=RALINE-14
  1. .S:RALINE<1 RALINE=1
  1. .I VALMBG'=RALINE S VALMBG=RALINE,VALMBCK="R"
  1. ; Previous Exception
  1. S RALINE=$O(@RAHLSEL@(VALMBG),-1)
  1. S:('RALINE) RALINE=1
  1. I RALINE'=VALMBG S VALMBG=RALINE,VALMBCK="R"
  1. ;
  1. NEND K RALINE,DIR
  1. Q
  1. ;
  1. ; =================================================================
  1. ;
  1. RESEND ; Re-Submit an HL7 Message Protocol
  1. ;
  1. K VALMSG
  1. D EN^DDIOL(" ","","!!!")
  1. I HL7EX<1 D Q
  1. .S VALMSG="Function not available - no messages to re-submit"
  1. .S VALMBCK=""
  1. .W $C(7)
  1. RESEND1 K DIR
  1. S DIR(0)="NAO^1:"_HL7EX_":0"
  1. S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
  1. S DIR("?")="Select one of the exceptions to Re-submit"
  1. S DIR("??")="^D RESH^RAHLEX1"
  1. D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
  1. ;
  1. S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
  1. S RALINE=RAXIEN
  1. I @RAHLEX@(RALINE+1,0)'["Error:" D G RESEND1
  1. .W $C(7)
  1. .D EN^DDIOL("Message already re-submitted or deleted. Not available for selection","","!?5")
  1. ;
  1. S RAXIEN=@RAHLSEL@(RAXIEN)
  1. S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
  1. D EN^DDIOL("Re-sending Message #"_HLIEN_"...","","!?5")
  1. H 1.5
  1. ;
  1. S RESEND=$$REPROC^HLUTIL(HLIEN,"RAHLTCPB")
  1. I RESEND'=0 D ; Fail !!
  1. .W $C(7)
  1. .S VALMSG="Error - Original message may have been purged"
  1. I RESEND=0 D ; Success !!
  1. .S HLMTIENS=HLIEN
  1. .S PURGE=$$SETPURG^HLUTIL(0)
  1. .I PURGE'=0 W $C(7) S VALMSG="Cannot change purge flag for message"
  1. .S %H=$H D YX^%DTC
  1. .S @RAHLEX@(RALINE+1,0)=IOINHI_" Message Re-submitted on "_Y_IOINORM
  1. .S DIK="^RA(79.3,",DA=RAXIEN D ^DIK ; Remove old report entry
  1. ;
  1. REND K RAI,RAXIEN,RALINE,RESEND,HLMTIENS,HLIEN,PURGE,DA,DIK,Y,%H
  1. ; Also HLUTIL calls
  1. K HL,HLA,HLARYTYP,HLECH,HLEID,HLFORMAT,HLFS,HLHDR,HLQ,HLRESLTA
  1. K VA,VADM,HLEIDS
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RESH ; Extended help
  1. D EN^DDIOL("Select one of the HL7 exceptions to Re-submit","","!")
  1. D EN^DDIOL("(If re-submitted successfully the exception will be deleted from file)","","!")
  1. Q
  1. ;
  1. ; =================================================================
  1. ;
  1. DELETE ; Function to delete Exception Node
  1. ;
  1. K VALMSG
  1. D EN^DDIOL(" ","","!!!")
  1. I HL7EX<1 D Q
  1. .S VALMSG="Function not available - No messages to delete"
  1. .S VALMBCK=""
  1. .W $C(7)
  1. DELETE1 K DIR
  1. S DIR(0)="NAO^1:"_HL7EX_":0"
  1. S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
  1. S DIR("?")="Select one of the exceptions to Delete"
  1. S DIR("??")="^D DELH^RAHLEX1"
  1. D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
  1. ;
  1. S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
  1. S RALINE=RAXIEN
  1. I @RAHLEX@(RALINE+1,0)'["Error:" D G DELETE1
  1. .W $C(7)
  1. .D EN^DDIOL("Exception already re-submitted or deleted. Not available for selection","","!?5")
  1. ;
  1. S RAXIEN=@RAHLSEL@(RAXIEN)
  1. S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
  1. D EN^DDIOL("Deleting Exception...","","!?5")
  1. H 1.5
  1. ;
  1. S DIK="^RA(79.3,",DA=RAXIEN D ^DIK
  1. ;
  1. S %H=$H D YX^%DTC
  1. S @RAHLEX@(RALINE+1,0)=IOINHI_" Reported Exception Deleted on "_Y_IOINORM
  1. ;
  1. DEND K RAI,RAXIEN,DA,DIK,HLIEN,RALINE,%H,Y
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DELH D EN^DDIOL("Select one of the HL7 exceptions to Delete","","!")
  1. D EN^DDIOL("(Note: Re-submitting a message is a more effective way to delete an exception)","","!")
  1. Q
  1. ;
  1. ; =================================================================