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

RAUTL9.m

Go to the documentation of this file.
  1. RAUTL9 ;HISC/FPT-Utility Routines ;4/9/97 10:08
  1. ;;5.0;Radiology/Nuclear Medicine;**13,27,51**;Mar 16, 1998
  1. EN1 ; allow lower & uppercase response to REPORT STATUS field
  1. ; called from [RA REPORT EDIT] & [RA VERIFY REPORT ONLY]
  1. ; " " routine UNVER+2^RARTE1
  1. ;
  1. N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
  1. D IARU
  1. I RATRUE=1 S DIR(0)="S^V:VERIFIED;R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
  1. I RATRUE=0 S DIR(0)="S^V:VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
  1. S DIR("A")="REPORT STATUS"
  1. S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
  1. S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
  1. S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
  1. D ^DIR K DIR,RATRUE
  1. I $D(DIRUT),(RAMT) D
  1. . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
  1. . ; set Report Status to 'Draft' if originally null, and user times out
  1. . ; or '^' out! Make sure xrefs are set!
  1. . Q
  1. Q:$D(DIRUT)
  1. I $E(Y)="V",'$D(^XUSEC("RA VERIFY",DUZ)) W !!,*7,"You do not have the appropriate privileges to verify a report." G EN1
  1. S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
  1. Q
  1. EN2 ; residents enter report status to pre-verify
  1. ; called from input templates [RA PRE-VERIFY REPORT EDIT] and [RA PRE-
  1. ; VERIFY REPORT ONLY]
  1. N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
  1. D IARU
  1. I RATRUE=1 S DIR(0)="S^R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
  1. I RATRUE=0 S DIR(0)="S^PD:PROBLEM DRAFT;D:DRAFT"
  1. S DIR("A")="RESIDENT PRE-VERIFICATION REPORT STATUS"
  1. S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
  1. S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
  1. S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
  1. D ^DIR K DIR,RATRUE
  1. I $D(DIRUT),(RAMT) D
  1. . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
  1. . ; set Report Status to 'Draft' if originally null, and user times out
  1. . ; or '^' out! Make sure xrefs are set!
  1. . Q
  1. Q:$D(DIRUT)
  1. S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
  1. Q
  1. EN3 ; residents pre-verify a report
  1. N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. W ! S DIR(0)="Y",DIR("A")="WANT TO PRE-VERIFY THIS REPORT"
  1. S DIR("?")="Answer YES to mark this report as pre-verified. Your user ID number, electronic signature code and the current date/time will be stored in the pre-verification fields of this entry."
  1. D ^DIR K DIR
  1. W ! Q:$D(DIRUT)
  1. S RAYN=+Y
  1. Q
  1. EN4 ; re-display report text question
  1. N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="Y",DIR("A")="Want to View the Report Text again" D ^DIR K DIR
  1. W ! Q:$D(DIRUT)
  1. S RAYN=Y
  1. Q
  1. EXIST ; Checks if word processing data exists called from [RA REPORT EDIT]
  1. ; and [RA PRE-VERIFY REPORT EDIT] templates.
  1. I RANODE="H",(($D(DTOUT))!($D(DUOUT))) D Q
  1. . D CHRSTOR
  1. I RANODE="R",(($D(DTOUT))!($D(DUOUT))) Q
  1. I RANODE="I",(($D(DTOUT))!($D(DUOUT))) Q
  1. I +$O(^RARPT(DA,RANODE,0)) D Q
  1. . N CNT,X,X1,X2,X3,X4,RAWPFLG S (RAWPFLG,X)=0
  1. . F S X=$O(^RARPT(DA,RANODE,X)) Q:X'>0 D Q:RAWPFLG
  1. .. S (CNT,X2)=0
  1. .. S X1=$G(^RARPT(DA,RANODE,X,0)) Q:X1']""
  1. .. S X2=$L(X1)
  1. .. F X3=1:1:X2 D Q:RAWPFLG
  1. ... S X4=$E(X1,X3) S:X4?1AN CNT=CNT+1
  1. ... S:X4'?1AN&(CNT>0) CNT=0
  1. ... S:CNT=2 RAWPFLG=1
  1. ... Q
  1. .. Q
  1. . I 'RAWPFLG D
  1. .. S Y=$S(RANODE="H":"@1",RANODE="R":"@2",1:"@3")
  1. .. W " ?? Invalid "
  1. .. W $S(RANODE="H":"Clinical History",RANODE="R":"Report",1:"Impression")
  1. .. W " text.",$C(7)
  1. .. K ^RARPT(DA,RANODE) ; Clear out bad WP
  1. .. Q
  1. . I RANODE="H",('RAWPFLG) D CHRSTOR
  1. . Q
  1. Q
  1. CHRSTOR ; Restores original data to the Clinical History field in the
  1. ; Rad/Nuc Med Reports File. Global: ^RARPT( File #: 74
  1. ; Set ^RARPT('DA',"H") array to value in ^TMP($J,"RA Clin Hist")
  1. N %X,%Y,Y
  1. S %X="^TMP($J,""RA Clin Hist"",",%Y="^RARPT("_DA_",""H"","
  1. D %XY^%RCR K ^TMP($J,"RA Clin Hist")
  1. Q
  1. CHSAVE ; Checks if word processing data exists called from [RA REPORT EDIT]
  1. ; and [RA PRE-VERIFY REPORT EDIT] templates. For the 'Clinical History'
  1. ; field.
  1. ; Save off existing text in a ^TMP global.
  1. K ^TMP($J,"RA Clin Hist") N %X,%Y
  1. S %X="^RARPT("_DA_",""H"",",%Y="^TMP($J,""RA Clin Hist"","
  1. D %XY^%RCR
  1. Q
  1. CHPRINT ; Prints text from the 'Clinical History' field in file 70
  1. ; from [RA REPORT EDIT] template. Added with patch RA*5*27 - bnt
  1. ;
  1. N DIR,DTOUT,DUOUT
  1. D EN^DDIOL("CLINICAL HISTORY:")
  1. S DIWL=1,DIWF="|WC75",RAV=0 K ^UTILITY($J,"W")
  1. F S RAV=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV)) Q:RAV'>0 D
  1. . S X=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV,0)
  1. . D ^DIWP
  1. D ^DIWW S X=""
  1. Q
  1. OUTTEXT(X,DIWF,DIWL,DIWR,RAFMAT,RALFF,RATFF) ; Output generic text using DIWP
  1. ;INPUT VARIABLES:
  1. ; 'X' --> Text to be formatted 'DIWF' --> Format control data
  1. ; 'DIWL' --> Left margin 'DIWR' --> Right margin
  1. ; 'RAFMAT' --> Tabs for columns 'RALFF' --> Leading line feed
  1. ; 'RATFF' --> Trailing line feed
  1. N DIW,DIWI,DIWT,DIWTC,DIWX,RALFMAT,RATFMAT,Y,Z
  1. Q:X']"" S RAFMAT=+$G(RAFMAT)
  1. S RALFF=$TR($G(RALFF),$G(RALFF),"!")
  1. S RATFF=$TR($G(RATFF),$G(RATFF),"!")
  1. S RALFMAT=RALFF_"?"_RAFMAT,RATFMAT=RATFF
  1. K ^UTILITY($J,"W",DIWL) D ^DIWP
  1. S Y=0 F S Y=$O(^UTILITY($J,"W",DIWL,Y)) Q:Y'>0 D
  1. . S Y(0)=$G(^UTILITY($J,"W",DIWL,Y,0)) W @RALFMAT,Y(0)
  1. . S Z=$O(^UTILITY($J,"W",DIWL,Y))
  1. . W:RATFMAT]""&(Z>0) @RATFF
  1. . Q
  1. K ^UTILITY($J,"W")
  1. Q
  1. STOPCHK ; does user want to stop task?
  1. I $$S^%ZTLOAD D
  1. . S ZTSTOP=1 K ZTREQ
  1. . W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
  1. . W !?10,"Option Name: ",$S($P($G(XQY0),"^")]"":$P($G(XQY0),"^"),1:"Unknown")
  1. . W !?10,"Option Menu Text: ",$S($P($G(XQY0),"^",2)]"":$P($G(XQY0),"^",2),1:"Unknown")
  1. . W !?10,"Task #: ",$S(+$G(ZTSK)>0:+$G(ZTSK),1:"Unknown")
  1. . Q
  1. Q
  1. UPDTPNT(RAIEN) ; Remove the possibility of broken pointers when a report
  1. ; is deleted from the Rad/Nuc Med Reports file (74). This checks the
  1. ; following files: Report Batches file (74.2) and the
  1. ; Report Distribution file (74.4)
  1. N A,B,DA,DIK
  1. I $D(^RABTCH(74.2,"D",RAIEN)) D
  1. . S A=0 F S A=$O(^RABTCH(74.2,"D",RAIEN,A)) Q:A'>0 D
  1. .. S B=0 F S B=$O(^RABTCH(74.2,"D",RAIEN,A,B)) Q:B'>0 D
  1. ... S DA=B,DA(1)=A,DIK="^RABTCH(74.2,"_DA(1)_",""R"","
  1. ... D ^DIK K DA,DIK
  1. ... Q
  1. .. Q
  1. . Q
  1. I $D(^RABTCH(74.4,"B",RAIEN)) D
  1. . S A=0 F S A=$O(^RABTCH(74.4,"B",RAIEN,A)) Q:A'>0 D
  1. .. S DA=A,DIK="^RABTCH(74.4," D ^DIK K DA,DIK
  1. .. Q
  1. . Q
  1. Q
  1. IARU ; Imaging Location allows released/unverified
  1. S RATRUE=$S($P(^RA(79.1,+$P(^RADPT(RADFN,"DT",RADTI,0),U,4),0),U,17)="Y":1,1:0)
  1. Q