| 1 | RAUTL9 ;HISC/FPT-Utility Routines ;4/9/97 10:08
|
---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**13,27,51**;Mar 16, 1998
|
---|
| 3 | EN1 ; allow lower & uppercase response to REPORT STATUS field
|
---|
| 4 | ; called from [RA REPORT EDIT] & [RA VERIFY REPORT ONLY]
|
---|
| 5 | ; " " routine UNVER+2^RARTE1
|
---|
| 6 | ;
|
---|
| 7 | N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
---|
| 8 | N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
|
---|
| 9 | D IARU
|
---|
| 10 | I RATRUE=1 S DIR(0)="S^V:VERIFIED;R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
|
---|
| 11 | I RATRUE=0 S DIR(0)="S^V:VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
|
---|
| 12 | S DIR("A")="REPORT STATUS"
|
---|
| 13 | S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
|
---|
| 14 | S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
|
---|
| 15 | S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
|
---|
| 16 | D ^DIR K DIR,RATRUE
|
---|
| 17 | I $D(DIRUT),(RAMT) D
|
---|
| 18 | . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
|
---|
| 19 | . ; set Report Status to 'Draft' if originally null, and user times out
|
---|
| 20 | . ; or '^' out! Make sure xrefs are set!
|
---|
| 21 | . Q
|
---|
| 22 | Q:$D(DIRUT)
|
---|
| 23 | I $E(Y)="V",'$D(^XUSEC("RA VERIFY",DUZ)) W !!,*7,"You do not have the appropriate privileges to verify a report." G EN1
|
---|
| 24 | S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
|
---|
| 25 | Q
|
---|
| 26 | EN2 ; residents enter report status to pre-verify
|
---|
| 27 | ; called from input templates [RA PRE-VERIFY REPORT EDIT] and [RA PRE-
|
---|
| 28 | ; VERIFY REPORT ONLY]
|
---|
| 29 | N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
---|
| 30 | N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
|
---|
| 31 | D IARU
|
---|
| 32 | I RATRUE=1 S DIR(0)="S^R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
|
---|
| 33 | I RATRUE=0 S DIR(0)="S^PD:PROBLEM DRAFT;D:DRAFT"
|
---|
| 34 | S DIR("A")="RESIDENT PRE-VERIFICATION REPORT STATUS"
|
---|
| 35 | S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
|
---|
| 36 | S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
|
---|
| 37 | S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
|
---|
| 38 | D ^DIR K DIR,RATRUE
|
---|
| 39 | I $D(DIRUT),(RAMT) D
|
---|
| 40 | . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
|
---|
| 41 | . ; set Report Status to 'Draft' if originally null, and user times out
|
---|
| 42 | . ; or '^' out! Make sure xrefs are set!
|
---|
| 43 | . Q
|
---|
| 44 | Q:$D(DIRUT)
|
---|
| 45 | S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
|
---|
| 46 | Q
|
---|
| 47 | EN3 ; residents pre-verify a report
|
---|
| 48 | N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
---|
| 49 | W ! S DIR(0)="Y",DIR("A")="WANT TO PRE-VERIFY THIS REPORT"
|
---|
| 50 | 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."
|
---|
| 51 | D ^DIR K DIR
|
---|
| 52 | W ! Q:$D(DIRUT)
|
---|
| 53 | S RAYN=+Y
|
---|
| 54 | Q
|
---|
| 55 | EN4 ; re-display report text question
|
---|
| 56 | N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
---|
| 57 | S DIR(0)="Y",DIR("A")="Want to View the Report Text again" D ^DIR K DIR
|
---|
| 58 | W ! Q:$D(DIRUT)
|
---|
| 59 | S RAYN=Y
|
---|
| 60 | Q
|
---|
| 61 | EXIST ; Checks if word processing data exists called from [RA REPORT EDIT]
|
---|
| 62 | ; and [RA PRE-VERIFY REPORT EDIT] templates.
|
---|
| 63 | I RANODE="H",(($D(DTOUT))!($D(DUOUT))) D Q
|
---|
| 64 | . D CHRSTOR
|
---|
| 65 | I RANODE="R",(($D(DTOUT))!($D(DUOUT))) Q
|
---|
| 66 | I RANODE="I",(($D(DTOUT))!($D(DUOUT))) Q
|
---|
| 67 | I +$O(^RARPT(DA,RANODE,0)) D Q
|
---|
| 68 | . N CNT,X,X1,X2,X3,X4,RAWPFLG S (RAWPFLG,X)=0
|
---|
| 69 | . F S X=$O(^RARPT(DA,RANODE,X)) Q:X'>0 D Q:RAWPFLG
|
---|
| 70 | .. S (CNT,X2)=0
|
---|
| 71 | .. S X1=$G(^RARPT(DA,RANODE,X,0)) Q:X1']""
|
---|
| 72 | .. S X2=$L(X1)
|
---|
| 73 | .. F X3=1:1:X2 D Q:RAWPFLG
|
---|
| 74 | ... S X4=$E(X1,X3) S:X4?1AN CNT=CNT+1
|
---|
| 75 | ... S:X4'?1AN&(CNT>0) CNT=0
|
---|
| 76 | ... S:CNT=2 RAWPFLG=1
|
---|
| 77 | ... Q
|
---|
| 78 | .. Q
|
---|
| 79 | . I 'RAWPFLG D
|
---|
| 80 | .. S Y=$S(RANODE="H":"@1",RANODE="R":"@2",1:"@3")
|
---|
| 81 | .. W " ?? Invalid "
|
---|
| 82 | .. W $S(RANODE="H":"Clinical History",RANODE="R":"Report",1:"Impression")
|
---|
| 83 | .. W " text.",$C(7)
|
---|
| 84 | .. K ^RARPT(DA,RANODE) ; Clear out bad WP
|
---|
| 85 | .. Q
|
---|
| 86 | . I RANODE="H",('RAWPFLG) D CHRSTOR
|
---|
| 87 | . Q
|
---|
| 88 | Q
|
---|
| 89 | CHRSTOR ; Restores original data to the Clinical History field in the
|
---|
| 90 | ; Rad/Nuc Med Reports File. Global: ^RARPT( File #: 74
|
---|
| 91 | ; Set ^RARPT('DA',"H") array to value in ^TMP($J,"RA Clin Hist")
|
---|
| 92 | N %X,%Y,Y
|
---|
| 93 | S %X="^TMP($J,""RA Clin Hist"",",%Y="^RARPT("_DA_",""H"","
|
---|
| 94 | D %XY^%RCR K ^TMP($J,"RA Clin Hist")
|
---|
| 95 | Q
|
---|
| 96 | CHSAVE ; Checks if word processing data exists called from [RA REPORT EDIT]
|
---|
| 97 | ; and [RA PRE-VERIFY REPORT EDIT] templates. For the 'Clinical History'
|
---|
| 98 | ; field.
|
---|
| 99 | ; Save off existing text in a ^TMP global.
|
---|
| 100 | K ^TMP($J,"RA Clin Hist") N %X,%Y
|
---|
| 101 | S %X="^RARPT("_DA_",""H"",",%Y="^TMP($J,""RA Clin Hist"","
|
---|
| 102 | D %XY^%RCR
|
---|
| 103 | Q
|
---|
| 104 | CHPRINT ; Prints text from the 'Clinical History' field in file 70
|
---|
| 105 | ; from [RA REPORT EDIT] template. Added with patch RA*5*27 - bnt
|
---|
| 106 | ;
|
---|
| 107 | N DIR,DTOUT,DUOUT
|
---|
| 108 | D EN^DDIOL("CLINICAL HISTORY:")
|
---|
| 109 | S DIWL=1,DIWF="|WC75",RAV=0 K ^UTILITY($J,"W")
|
---|
| 110 | F S RAV=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV)) Q:RAV'>0 D
|
---|
| 111 | . S X=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV,0)
|
---|
| 112 | . D ^DIWP
|
---|
| 113 | D ^DIWW S X=""
|
---|
| 114 | Q
|
---|
| 115 | OUTTEXT(X,DIWF,DIWL,DIWR,RAFMAT,RALFF,RATFF) ; Output generic text using DIWP
|
---|
| 116 | ;INPUT VARIABLES:
|
---|
| 117 | ; 'X' --> Text to be formatted 'DIWF' --> Format control data
|
---|
| 118 | ; 'DIWL' --> Left margin 'DIWR' --> Right margin
|
---|
| 119 | ; 'RAFMAT' --> Tabs for columns 'RALFF' --> Leading line feed
|
---|
| 120 | ; 'RATFF' --> Trailing line feed
|
---|
| 121 | N DIW,DIWI,DIWT,DIWTC,DIWX,RALFMAT,RATFMAT,Y,Z
|
---|
| 122 | Q:X']"" S RAFMAT=+$G(RAFMAT)
|
---|
| 123 | S RALFF=$TR($G(RALFF),$G(RALFF),"!")
|
---|
| 124 | S RATFF=$TR($G(RATFF),$G(RATFF),"!")
|
---|
| 125 | S RALFMAT=RALFF_"?"_RAFMAT,RATFMAT=RATFF
|
---|
| 126 | K ^UTILITY($J,"W",DIWL) D ^DIWP
|
---|
| 127 | S Y=0 F S Y=$O(^UTILITY($J,"W",DIWL,Y)) Q:Y'>0 D
|
---|
| 128 | . S Y(0)=$G(^UTILITY($J,"W",DIWL,Y,0)) W @RALFMAT,Y(0)
|
---|
| 129 | . S Z=$O(^UTILITY($J,"W",DIWL,Y))
|
---|
| 130 | . W:RATFMAT]""&(Z>0) @RATFF
|
---|
| 131 | . Q
|
---|
| 132 | K ^UTILITY($J,"W")
|
---|
| 133 | Q
|
---|
| 134 | STOPCHK ; does user want to stop task?
|
---|
| 135 | I $$S^%ZTLOAD D
|
---|
| 136 | . S ZTSTOP=1 K ZTREQ
|
---|
| 137 | . W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
|
---|
| 138 | . W !?10,"Option Name: ",$S($P($G(XQY0),"^")]"":$P($G(XQY0),"^"),1:"Unknown")
|
---|
| 139 | . W !?10,"Option Menu Text: ",$S($P($G(XQY0),"^",2)]"":$P($G(XQY0),"^",2),1:"Unknown")
|
---|
| 140 | . W !?10,"Task #: ",$S(+$G(ZTSK)>0:+$G(ZTSK),1:"Unknown")
|
---|
| 141 | . Q
|
---|
| 142 | Q
|
---|
| 143 | UPDTPNT(RAIEN) ; Remove the possibility of broken pointers when a report
|
---|
| 144 | ; is deleted from the Rad/Nuc Med Reports file (74). This checks the
|
---|
| 145 | ; following files: Report Batches file (74.2) and the
|
---|
| 146 | ; Report Distribution file (74.4)
|
---|
| 147 | N A,B,DA,DIK
|
---|
| 148 | I $D(^RABTCH(74.2,"D",RAIEN)) D
|
---|
| 149 | . S A=0 F S A=$O(^RABTCH(74.2,"D",RAIEN,A)) Q:A'>0 D
|
---|
| 150 | .. S B=0 F S B=$O(^RABTCH(74.2,"D",RAIEN,A,B)) Q:B'>0 D
|
---|
| 151 | ... S DA=B,DA(1)=A,DIK="^RABTCH(74.2,"_DA(1)_",""R"","
|
---|
| 152 | ... D ^DIK K DA,DIK
|
---|
| 153 | ... Q
|
---|
| 154 | .. Q
|
---|
| 155 | . Q
|
---|
| 156 | I $D(^RABTCH(74.4,"B",RAIEN)) D
|
---|
| 157 | . S A=0 F S A=$O(^RABTCH(74.4,"B",RAIEN,A)) Q:A'>0 D
|
---|
| 158 | .. S DA=A,DIK="^RABTCH(74.4," D ^DIK K DA,DIK
|
---|
| 159 | .. Q
|
---|
| 160 | . Q
|
---|
| 161 | Q
|
---|
| 162 | IARU ; Imaging Location allows released/unverified
|
---|
| 163 | S RATRUE=$S($P(^RA(79.1,+$P(^RADPT(RADFN,"DT",RADTI,0),U,4),0),U,17)="Y":1,1:0)
|
---|
| 164 | Q
|
---|