Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU31.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU31.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU31.m
r613 r623 1 MAGGTU31 ;WOIFO/GEK - Silent calls for Imaging ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**46,59**;Nov 27, 2007;Build 20 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 11 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 Q 20 ATTSTAT(IEN) ; Return a sentence saying if the Image was attached 21 ; to the TIU NOte before or after the Note was signed. 22 ; was signed. 23 N SIGNDT,NOTE,MARR,AMMEND,N2,MAGDT,NC,CLOSDT,X 24 S N2=$G(^MAG(2005,IEN,2)) 25 I $P(N2,"^",6)'=8925 Q "" 26 S MAGDT=$S($P(N2,"^",11):$P(N2,"^",11),1:$P(N2,"^",1)) 27 S NOTE=$P(N2,"^",7) 28 S NC=NOTE_"," 29 D GETS^DIQ(8925,NOTE,".01;.06;1501;1606","I","MARR") 30 I $D(DIERR) Q "Error: Note-"_NOTE_" : "_$G(^TMP("DIERR",$J,1,"TEXT",1)) 31 I (MARR(8925,NC,".01","I")=81)!(MARR(8925,NC,".06","I")>0) Q "Image is attached to an Addendum" 32 S SIGNDT=MARR(8925,NC,"1501","I") 33 S CLOSDT=MARR(8925,NC,"1606","I") 34 I CLOSDT]"" D Q X 35 . I $P(CLOSDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=CLOSDT S X="Image was attached Same Day as Note was Electronically Filed." Q 36 . I MAGDT>CLOSDT S X="Image was attached After Note was Electronically Filed." Q 37 . S X="Image was attached Before Note was Electronically Filed." Q 38 . Q 39 I SIGNDT="" Q "Image is attached to an UnSigned Note." 40 I $P(SIGNDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=SIGNDT Q "Image was attached Same Day as Note was Signed." 41 I MAGDT>SIGNDT Q "Image was attached After the Note was Signed." 42 Q "Image was attached Before the Note was Signed." 43 USERKEYS(MAGK) ; RPC [MAGGUSERKEYS] (called from MAGGTU3) 44 N Y 45 N MAGKS ; list of keys to send to XUS KEY CHECK 46 N MAGKG ; list returned from XUS KEY CHECK 47 N I,J,MAGMED,MAGKEY,MAGPLC 48 K MAGK 49 S MAGPLC=+$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002 50 S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U) 51 I 'MAGKEY S MAGK(0)="CAPTURE KEYS OFF" 52 E S MAGK(0)="CAPTURE KEYS ON" 53 N X S X="MAG",I=0 54 F S X=$O(^XUSEC(X)) Q:$E(X,1,3)'="MAG" D 55 . S I=I+1,MAGKS(I)=X 56 D OWNSKEY^XUSRB(.MAGKG,.MAGKS) 57 S I=0,J=0,MAGMED=0 58 F S I=$O(MAGKG(I)) Q:I="" D 59 . Q:MAGKG(I)=0 60 . S J=J+1,MAGK(J)=MAGKS(I) 61 . I MAGKS(I)["MAGCAP MED" S MAGMED=1 62 I MAGMED S J=J+1,MAGK(J)="MAGCAP MED" 63 Q 64 GETINFO(MAGRY,IEN) ; RPC [MAG4 GET IMAGE INFO]Called from MAGGTU3 65 ; Call (3.0p8) to get information on 1 image 66 ; and Display in the Image Information Window 67 N Y,J,JI,I,CT,IENC,FLAGS,SNGRP,Z,M40,T,QACHK,OBJTYP,VAL,LBL 68 S I=0,CT=0 69 S MAGRY(CT)="Image ID#: "_IEN 70 I $D(^MAG(2005.1,IEN)) D Q 71 . S CT=CT+1,MAGRY(CT)=" STATUS: "_"HAS BEEN DELETED. !!" 72 . S CT=CT+1,MAGRY(CT)="Deleted By: "_$$GET1^DIQ(2005.1,IEN,30,"E") 73 . S CT=CT+1,MAGRY(CT)=" Reason: "_$$GET1^DIQ(2005.1,IEN,30.2,"E") 74 . S CT=CT+1,MAGRY(CT)=" Date: "_$$GET1^DIQ(2005.1,IEN,30.1,"E") 75 . Q 76 S M40=$G(^MAG(2005,IEN,40)),T=$P(M40,"^",3) 77 S Z=$P($G(^MAG(2005,IEN,0)),"^",10) I Z D 78 . S CT=CT+1,MAGRY(CT)=" is in Group#: "_Z_" ("_+$P(^MAG(2005,Z,1,0),"^",4)_" images)" 79 . D CHK^MAGGSQI(.QACHK,Z) Q:QACHK(0) 80 . S CT=CT+1,MAGRY(CT)=" QA Warning - Group#: "_Z_" "_$P(QACHK(0),"^",2) 81 . Q 82 S OBJTYP=$P(^MAG(2005,IEN,0),"^",6) 83 S SNGRP="FLDS" 84 I (+$O(^MAG(2005,IEN,1,0)))!(OBJTYP=11)!(OBJTYP=16) D 85 . S CT=CT+1,MAGRY(CT)=$P($G(^MAG(2005,IEN,40)),"^",1)_" Group of "_+$P($G(^MAG(2005,IEN,1,0)),U,4) 86 . S SNGRP="FLDG" 87 . Q 88 K QACHK 89 D CHK^MAGGSQI(.QACHK,IEN) I 'QACHK(0) D 90 . S CT=CT+1,MAGRY(CT)=" QA Warning - Image#: "_IEN_" "_$P(QACHK(0),"^",2) 91 N MAGOUT,MAGERR,MAGVAL,PKG 92 S IENC=IEN_"," 93 S FLAGS="EN" 94 S I=-1 95 S PKG="" 96 F S I=I+1,Z=$T(@SNGRP+I) Q:$P(Z,";",3)="end" D 97 . S J=$P(Z,";",4),JI=J_";" 98 . K MAGOUT 99 . S CT=CT+1,MAGRY(CT)=$P(Z,";",3) 100 . I J=41 D Q ; Need to compute the Class. Class field in Image File is wrong. 101 . . S MAGVAL=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^MAG(2005.82,$P(^MAG(2005.83,T,0),"^",2),0),"^",1)) 102 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL 103 . . Q 104 . D GETS^DIQ(2005,IEN,JI,FLAGS,"MAGOUT","MAGERR") 105 . ; Get Extension from FileRef 106 . I J=1 S MAGVAL=$P($G(MAGOUT(2005,IENC,J,"E")),".",2) 107 . E S MAGVAL=$G(MAGOUT(2005,IENC,J,"E")) 108 . S MAGVAL=$TR(MAGVAL,"&","+") 109 . I J=40 S PKG=MAGVAL 110 . I ((J>=50)&(J<=54)) D Q 111 . . I PKG'="LAB" K MAGRY(CT) Q 112 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL 113 . . Q 114 . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL 115 ; Compare Parent Association Date with Date/Time Note Signed. 116 I $P(^MAG(2005,IEN,0),"^",10) S IEN=$P(^MAG(2005,IEN,0),"^",10) 117 I $P(^MAG(2005,IEN,2),"^",6)=8925 S CT=CT+1,MAGRY(CT)=$$ATTSTAT^MAGGTU31(IEN) 118 ; 119 I (OBJTYP=11),($P($G(^MAG(2005,IEN,100)),"^",6)="") D 120 . S X=$O(^MAG(2005,IEN,1,0)) 121 . S IEN=+$G(^MAG(2005,IEN,1,X,0)) 122 . Q 123 I $P($G(^MAG(2005,IEN,100)),"^",6)]"" D 124 . I OBJTYP=11 D ; If a Group, get Object Type of First Child 125 . . S Z=$O(^MAG(2005,IEN,1,0)) 126 . . I 'Z Q 127 . . S Z=+$G(^MAG(2005,IEN,1,Z,0)) 128 . . S OBJTYP=+$P($G(^MAG(2005,Z,0)),"^",6) ; Object of First Child 129 . . Q 130 . S OBJTYP=","_OBJTYP_"," 131 . S LBL="",VAL="" 132 . I ",3,9,10,12,100,"[OBJTYP S LBL="Image Creation Date: " ; "Acquisition Date"; 133 . I ",15,101,102,103,104,105,"[OBJTYP S LBL="Document Creation Date: " 134 . I LBL="" S LBL="Image Creation Date: " 135 . S VAL=$$GET1^DIQ(2005,IEN,110,"E") S:(VAL="") VAL="N/A" 136 . S CT=CT+1,MAGRY(CT)=LBL_VAL 137 . Q 138 Q 139 ; 140 FLDS ;;Format: ;3;; 141 ;;Extension: ;1;; 142 FLDG ;;Patient: ;5;; 143 ;;Desc: ;10;; 144 ;;Procedure: ;6;; 145 ;; Date: ;15;; 146 ;;Class: ;41;; 147 ;;Package: ;40;; 148 ;;Type: ;42;; 149 ;;Proc/Event: ;43;; 150 ;;Spec/SubSpec: ;44;; 151 ;;Origin: ;45;; 152 ;;Accession # ;50;; 153 ;;Specimen Desc ;51;; 154 ;;Specimen# ;52;; 155 ;;Stain ;53;; 156 ;;Objective ;54;; 157 ;;Captured on: ;7;; 158 ;; by: ;8;; 159 ;;end;; 1 MAGGTU31 ;WOIFO/GEK - Silent calls for Imaging ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 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 ATTSTAT(IEN) ; Return a sentence saying if the Image was attached 20 ; to the TIU NOte before or after the Note was signed. 21 ; was signed. 22 N SIGNDT,NOTE,MARR,AMMEND,N2,MAGDT,NC,CLOSDT,X 23 S N2=$G(^MAG(2005,IEN,2)) 24 I $P(N2,"^",6)'=8925 Q "" 25 S MAGDT=$S($P(N2,"^",11):$P(N2,"^",11),1:$P(N2,"^",1)) 26 S NOTE=$P(N2,"^",7) 27 S NC=NOTE_"," 28 D GETS^DIQ(8925,NOTE,".01;.06;1501;1606","I","MARR") 29 I $D(DIERR) Q "Error: Note-"_NOTE_" : "_$G(^TMP("DIERR",$J,1,"TEXT",1)) 30 I (MARR(8925,NC,".01","I")=81)!(MARR(8925,NC,".06","I")>0) Q "Image is attached to an Addendum" 31 S SIGNDT=MARR(8925,NC,"1501","I") 32 S CLOSDT=MARR(8925,NC,"1606","I") 33 I CLOSDT]"" D Q X 34 . I $P(CLOSDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=CLOSDT S X="Image was attached Same Day as Note was Electronically Filed." Q 35 . I MAGDT>CLOSDT S X="Image was attached After Note was Electronically Filed." Q 36 . S X="Image was attached Before Note was Electronically Filed." Q 37 . Q 38 I SIGNDT="" Q "Image is attached to an UnSigned Note." 39 I $P(SIGNDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=SIGNDT Q "Image was attached Same Day as Note was Signed." 40 I MAGDT>SIGNDT Q "Image was attached After the Note was Signed." 41 Q "Image was attached Before the Note was Signed." 42 USERKEYS(MAGK) ; RPC [MAGGUSERKEYS] (called from MAGGTU3) 43 N Y 44 N MAGKS ; list of keys to send to XUS KEY CHECK 45 N MAGKG ; list returned from XUS KEY CHECK 46 N I,J,MAGMED,MAGKEY,MAGPLC 47 K MAGK 48 S MAGPLC=+$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002 49 S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U) 50 I 'MAGKEY S MAGK(0)="CAPTURE KEYS OFF" 51 E S MAGK(0)="CAPTURE KEYS ON" 52 N X S X="MAG",I=0 53 F S X=$O(^XUSEC(X)) Q:$E(X,1,3)'="MAG" D 54 . S I=I+1,MAGKS(I)=X 55 D OWNSKEY^XUSRB(.MAGKG,.MAGKS) 56 S I=0,J=0,MAGMED=0 57 F S I=$O(MAGKG(I)) Q:I="" D 58 . Q:MAGKG(I)=0 59 . S J=J+1,MAGK(J)=MAGKS(I) 60 . I MAGKS(I)["MAGCAP MED" S MAGMED=1 61 I MAGMED S J=J+1,MAGK(J)="MAGCAP MED" 62 Q
Note:
See TracChangeset
for help on using the changeset viewer.
