| 1 | MAGDCCS2 ;WOIFO/MLH - DICOM Correct - Clinical Specialties - subroutines ; 05/06/2004 06:32
|
|---|
| 2 | ;;3.0;IMAGING;**10,11,30**;16-September-2004
|
|---|
| 3 | ;; +---------------------------------------------------------------+
|
|---|
| 4 | ;; | Property of the US Government. |
|
|---|
| 5 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 6 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 7 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 8 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 9 | ;; | telephone (301) 734-0100. |
|
|---|
| 10 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | Q
|
|---|
| 19 | ; Routine to create the MAGDY variable needed by MAGDCCS routine when
|
|---|
| 20 | ; manually correcting DICOM FIX files.
|
|---|
| 21 | EN ;
|
|---|
| 22 | ; MAGDY variable to be created during this execution.
|
|---|
| 23 | N D,DIC,DZ,MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGSSN
|
|---|
| 24 | S MAGBEG=1070101,MAGEND=$$DT^XLFDT
|
|---|
| 25 | W !,"*** Select a request/consult with whose ***"
|
|---|
| 26 | W !,"*** TIU note to associate this image ***"
|
|---|
| 27 | S DIC="^GMR(123,",DIC(0)="AENZ"
|
|---|
| 28 | S DIC("A")="Enter patient or request/consultation: "
|
|---|
| 29 | S D="F",DZ="??"
|
|---|
| 30 | S DIC("W")="W "" REQ/CON #"",Y"
|
|---|
| 31 | S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,1)" ; TO SERVICE
|
|---|
| 32 | S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,.02)" ; PATIENT NAME
|
|---|
| 33 | ;
|
|---|
| 34 | D IX^DIC
|
|---|
| 35 | Q:$D(DUOUT)
|
|---|
| 36 | Q:'$D(Y(0)) ; nothing selected
|
|---|
| 37 | S (MAGDFN,MAGX)=$P(Y(0),U,2)_"~"_Y
|
|---|
| 38 | ;
|
|---|
| 39 | D ONE ; Lookup was on req/con number and successful
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | PTINFO() ;
|
|---|
| 43 | N INFO,MAGOUT
|
|---|
| 44 | I '$D(MAGDFN) Q ""
|
|---|
| 45 | D GETS^DIQ(2,MAGDFN,".01;.09","E","MAGOUT","MAGERR")
|
|---|
| 46 | I $D(MAGERR) Q ""
|
|---|
| 47 | I $D(MAGOUT) D Q INFO
|
|---|
| 48 | . S INFO=$G(MAGOUT(2,MAGDFN_",",.01,"E"))
|
|---|
| 49 | . S INFO=INFO_"^"_$G(MAGOUT(2,MAGDFN_",",.09,"E"))
|
|---|
| 50 | Q ""
|
|---|
| 51 | ;
|
|---|
| 52 | ONE ; Process the single entry that was selected.
|
|---|
| 53 | ; MAGDFN,MAGX variables expected from EN
|
|---|
| 54 | I 'MAGDFN,'+MAGX Q
|
|---|
| 55 | N BEG,CASE,CDATE,CS,DATA,END,FLDS,INFO,MAGCASE,MAGCNI,MAGDATE,MAGDTI
|
|---|
| 56 | N MAGEXST,MAGLOC,MAGNME,MAGOUT,MAGPIEN,MAGPRC,MAGPSET,MAGPST,MAGRPT
|
|---|
| 57 | N PP,PSET,RAENTRY,RAMEMLOW,RAPRTSET,RIEN,STAT,X,X1,X2,XX
|
|---|
| 58 | N RARPT,RADFN,RADTI,RACNI ;<--Variables needed for EN1^RAUTL20
|
|---|
| 59 | ; RAUTL20 used to retrieve if case is part of a print set.
|
|---|
| 60 | N MAGRCARY ; array of req/con data from file 123
|
|---|
| 61 | N MAGIENS ; internal entry number for MAGRCARY
|
|---|
| 62 | ;
|
|---|
| 63 | S MAGDFN=$P(MAGX,"~"),INFO=$$PTINFO
|
|---|
| 64 | S MAGNME=$P(INFO,"^"),MAGSSN=$P(INFO,"^",2)
|
|---|
| 65 | S MAGCASE=$P($P(MAGX,"~",2),U)
|
|---|
| 66 | S (MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAGLOC,MAGDATE,MAGEXST,MAGPST)=""
|
|---|
| 67 | K MAGRCARY D GETS^DIQ(123,MAGCASE,"*","EI","MAGRCARY")
|
|---|
| 68 | ;
|
|---|
| 69 | S MAGIENS=$O(MAGRCARY(123,""))
|
|---|
| 70 | S MAGPRC=MAGRCARY(123,MAGIENS,4,"E") ; procedure
|
|---|
| 71 | S MAGLOC=MAGRCARY(123,MAGIENS,1,"E") ; to service
|
|---|
| 72 | S MAGDATE=MAGRCARY(123,MAGIENS,.01,"E") ; request date
|
|---|
| 73 | S MAGPST=MAGRCARY(123,MAGIENS,8,"E") ; procedure status
|
|---|
| 74 | W !,"PATIENT: ",MAGNME,?51,"SSN: ",MAGSSN
|
|---|
| 75 | W !,"Req/Con No.",?13,"Procedure",?38,"To Service",?58,"Req Date"
|
|---|
| 76 | W !,"-----------",?13,"---------",?38,"----------------",?58,"--------"
|
|---|
| 77 | W !,MAGCASE,?13,MAGPRC,?38,MAGLOC,?58,MAGDATE
|
|---|
| 78 | W !,"Exam status: ",MAGEXST," "," ",$G(MAGPST)
|
|---|
| 79 | D MAGDY
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | MAGDY ;
|
|---|
| 83 | S MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGSSN_"^"_"GMRC-"_MAGCASE_"^"_MAGPRC_"^"_MAGDTI
|
|---|
| 84 | S MAGDY=MAGDY_"^"_MAGCNI_"^"_MAGPIEN_"^"_$G(MAGPST)_"^"
|
|---|
| 85 | K MAGNME,MAGSSN,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST
|
|---|
| 86 | Q
|
|---|
