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

RAUTL19.m

Go to the documentation of this file.
  1. RAUTL19 ;HISC/GJC-Utility Routine ; Apr 28, 2020@14:47:46
  1. ;;5.0;Radiology/Nuclear Medicine;**1,31,169**;Mar 16, 1998;Build 2
  1. ;
  1. ;IA Type File Routine Tag
  1. ;------------------------------------------------
  1. ;1362 (C) ORB3 EN
  1. ;
  1. PRELIM(RAIMG) ; Called from '1^RAMAIN1'
  1. W !!?(IOM-$L(RAHDR)\2),RAHDR K %ZIS S %ZIS="MQ" W !
  1. D ^%ZIS Q:POP
  1. I $D(IO("Q")) D W ! Q
  1. . S ZTDESC="Rad/Nuc Med Exam Status Entry/Edit Report",ZTSAVE("RA*")=""
  1. . S ZTRTN="EN1^RAUTL19" D ^%ZTLOAD
  1. . W !?5,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
  1. . Q
  1. I IO'=IO(0) U IO
  1. D EN1 I IO'=IO(0) D HOME^%ZIS
  1. Q
  1. EN1 ; Check data consistency
  1. D EN1^RAUTL19C
  1. Q
  1. NOTNEED ;non-radiopharm used don't need .5n and .6n fields answered
  1. Q:RANODE(.5)'["Y"&(RANODE(.6)'["Y")
  1. W !!,RADASH,"Checking fields not needed by non-nucmed imaging",RADASH
  1. W !!?11,"Within : ",RAIMG,!?5,"The following need not be answered :"
  1. W !?5,"Exam Status '",$P(RANODE(0),"^"),"'",!?5,"order ("_RAO_") '",!
  1. N RAIMG0,RAIMG1,RAIMG2
  1. S RAIMG1=.50,RAIMG2=.69,RAIMG0=RAIMG1
  1. F S RAIMG0=$O(RAPIECE(RAIMG0)) Q:RAIMG0>RAIMG2 Q:RAIMG0="" I RAPIECE(RAIMG0)="Y" W !,"'",$P($G(^DD(72,RAIMG0,.1)),U),"' is set to ",RAPIECE(RAIMG0)
  1. W !
  1. Q
  1. CKPRNTR ;ck that all img locations for that img type has a dosg tkt prntr
  1. N RAIMG72,RA791,RA791FL
  1. S RAIMG72=$P(RANODE(0),U,7),RA791=0,RA791FL=0
  1. F S RA791=$O(^RA(79.1,"BIMG",RAIMG72,RA791)) Q:'RA791 I $P(^RA(79.1,RA791,0),U,23)="" D PRNTASGN Q:RAOUT
  1. Q
  1. PRNTASGN ;
  1. W:'RA791FL !!,RADASH,"Checking Dosage Ticket Printer Assignment",RADASH
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W:'RA791FL !!?11,"Within : ",RAIMG,!?5,"Exam Status '",$P(RANODE(0),"^"),"'",!?5,"order ("_RAO_") '"_$P($G(^DD(72,.611,.1)),U)_"'",!?5,"is set to 'Yes' but",!?5,"there's no Dosage Ticket Printer assigned to :"
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. S RA791FL=1
  1. W !?15,$P(^SC($P(^RA(79.1,RA791,0),U),0),U)
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. Q
  1. WRPAIR I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W:'RACHKERR !!,RADASH,"Checking fields that are inter-related",RADASH
  1. S RACHKERR=1 ;only write this once
  1. Q
  1. CKPAIR ; when field I is Y, then field J must also be Y at current/lower status
  1. D CKPAIR^RAUTL19C
  1. Q
  1. WRWAIT W:'RAWATERR !!,RADASH,"Checking ",$P(RANODE(0),U,1),"'s 'ASK' and 'REQUIRED' fields",RADASH,!?11,"within : ",RAIMG,!
  1. S RAWATERR=1 ;only write this once regardless of number of errors found
  1. Q
  1. CKWAIT ; CKWAIT is only done for WAITING FOR EXAM and assumes order seq = 1
  1. D CKWAIT^RAUTL19C
  1. Q
  1. ASKPRI(A,B,C) ; Check all prior statuses to ensure that the specific required
  1. ; data field is set to 'yes', and the field for data asked is set to
  1. ; 'yes'.
  1. ; 'A' is the I-Type (external) <-> 'B' is the current status order
  1. ; 'C' is fld that shd be prompted <-> 'E' is the order #
  1. ; 'F' is the ien of file 72. <-> 'RA' hold the entire data node
  1. ; 'RAFLD' value of the field <-> 'RAPCE' where data found on node
  1. N E,F,RA,RAFLD,RAPCE S E=0
  1. F S E=$O(^RA(72,"AA",A,E)) Q:E'>0!(E'<B) D Q:RAFLG
  1. . S F=+$O(^RA(72,"AA",A,E,0)) Q:'F
  1. . S RA(0)=$G(^RA(72,F,0))
  1. . I $$UP^XLFSTR($P(RA(0),"^",5))="Y" D ; if on Status Tracking
  1. .. S RAPCE=$E(C,3,$L(C)) ;pce is after 2nd byte, & is 1 or 2 bytes long
  1. .. S RA($E(C,1,2))=$G(^RA(72,F,$E(C,1,2))),RAFLD=$P(RA($E(C,1,2)),"^",RAPCE)
  1. .. S:$$UP^XLFSTR(RAFLD)="Y" RAFLG=1
  1. .. Q
  1. . Q
  1. Q RAFLG
  1. PROCTY(Y) ; Passes back the Procedure Type. 'Y' is the ien in the
  1. ; Rad/Nuc Med Procedure file '^RAMIS(71,'.
  1. Q $$UP^XLFSTR($P($G(^RAMIS(71,+Y,0)),"^",6))
  1. LK(X) ; Lock a patient record when updating orders
  1. ; 'X' input in a variable pointer format: 'record_#;data_file__root'
  1. ; Pass back 'Y': '0' if lock fails, '1' if successful
  1. ; 'Y' defined in LK^ORX2
  1. Q 1
  1. ULK(X) ; Unlock a patient record
  1. ; 'X' input in a variable pointer format: 'record_#;data_file__root'
  1. Q
  1. ACCVIO ; Lack of Imaging Location access for a user
  1. W !?5,$C(7),"You do not have access to any Imaging Locations."
  1. W !?5,"Contact your ADPAC."
  1. Q
  1. DEV(X) ; Lookup an entry in the Device (3.5) file.
  1. ; Called from the [RA LOCATION PARAMETERS] input template. File: 79.1
  1. ; Input: X=IEN of Device
  1. ; Output: Name of Device
  1. Q:'$L(X) ""
  1. I X?1N.NP Q $P($G(^%ZIS(1,X,0)),"^")
  1. Q ""
  1. OENO(X) ; OE/RR notifications, called from: RAORR1, RAORD1 & RAO7RO
  1. ; Input: 'X' -> ien of the Rad/Nuc Med Orders file (75.1)
  1. ; Notification: #51 - STAT IMAGING REQUEST & #52 - URGENT IMAGING REQUEST
  1. N I,RA751,RADFN,RADUZ,RALOC,RAMSG,RANOTY,RAORIFN
  1. S RA751=$G(^RAO(75.1,X,0)),RADFN=+$P(RA751,"^"),RANOTY=$P(RA751,"^",6)
  1. S RAORIFN=$P(RA751,"^",7) ;CPRS order IFN RA5P169
  1. S RANOTY=$S(RANOTY=1:51,RANOTY=2:52,1:"") Q:RANOTY=""
  1. S RALOC=$P(RA751,"^",20) Q:RALOC']"" ; no i-loc, no alert
  1. S I=0 F S I=$O(^RA(79.1,RALOC,"REC","B",I)) Q:I'>0 D
  1. . S RADUZ(I)=""
  1. . Q
  1. S:($D(RADUZ)\10)=0 RADUZ="" ; NOTE: if no rad/nuc med recipients, check
  1. ; oe/rr to see if they have any recipients for this particular alert
  1. S RAMSG="Imaging Request Urgency: "_$$XTERNAL^RAUTL5($P(RA751,"^",6),$P($G(^DD(75.1,6,0)),"^",2))
  1. D EN^ORB3(RANOTY,RADFN,RAORIFN,.RADUZ,RAMSG)
  1. Q
  1. VRADE ;VistaRad Category data entry
  1. I '$$IMAGE^RARIC1() W !!,"Current system is not running Vista Imaging -- nothing done.",! Q
  1. S DIC="^RA(79.2,",DIC(0)="QEAMNZ",DIC("A")="Select an Imaging Type: "
  1. D ^DIC K DIC G:+Y'>0 VRADQ
  1. S RAOUT=0,RAIMGTYI=+Y,RAIMGTYJ=$P(Y,U,2)
  1. F D Q:RAOUT
  1. . K DINUM,DLAYGO,D0 W !
  1. . S DIC="^RA(72,",DIC(0)="QEAZ" ; don't allow LAYGO
  1. . S DIC("S")="I +$P(^(0),U,7)=RAIMGTYI"
  1. . S RADICW(1)="N RA S RA(0)=^(0),RA(3)=$P(RA(0),U,3) "
  1. . S RADICW(2)="W ?35,""Imaging Type: "",?49,RAIMGTYJ"
  1. . S RADICW(3)=",!?35,""Order: "",?42,RA(3)"
  1. . S DIC("W")=RADICW(1)_RADICW(2)_RADICW(3)
  1. . D ^DIC K DIC,RADICW
  1. . I +Y'>0 S RAOUT=1 Q
  1. . S DA=+Y,DIE="^RA(72,",DR="9" D ^DIE
  1. . Q
  1. VRADQ K RAIMGTYI,RAIMGTYJ,RAOUT
  1. Q