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

MAGGTU31.m

Go to the documentation of this file.
  1. MAGGTU31 ;WOIFO/GEK/SG/NST - Silent calls for Imaging ; 04 Nov 2010 10:55 AM
  1. ;;3.0;IMAGING;**46,59,93,117**;Mar 19, 2002;Build 2238;Jul 15, 2011
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ATTSTAT(IEN) ; Return a sentence saying if the Image was attached
  1. ; to the TIU NOte before or after the Note was signed.
  1. ; was signed.
  1. N SIGNDT,NOTE,MARR,AMMEND,N2,MAGDT,NC,CLOSDT,X
  1. S N2=$G(^MAG(2005,IEN,2))
  1. I $P(N2,"^",6)'=8925 Q ""
  1. S MAGDT=$S($P(N2,"^",11):$P(N2,"^",11),1:$P(N2,"^",1))
  1. S NOTE=$P(N2,"^",7)
  1. S NC=NOTE_","
  1. D GETS^DIQ(8925,NOTE,".01;.06;1501;1606","I","MARR")
  1. I $D(DIERR) Q "Error: Note-"_NOTE_" : "_$G(^TMP("DIERR",$J,1,"TEXT",1))
  1. I (MARR(8925,NC,".01","I")=81)!(MARR(8925,NC,".06","I")>0) Q "Image is attached to an Addendum"
  1. S SIGNDT=MARR(8925,NC,"1501","I")
  1. S CLOSDT=MARR(8925,NC,"1606","I")
  1. I CLOSDT]"" D Q X
  1. . 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
  1. . I MAGDT>CLOSDT S X="Image was attached After Note was Electronically Filed." Q
  1. . S X="Image was attached Before Note was Electronically Filed." Q
  1. . Q
  1. I SIGNDT="" Q "Image is attached to an UnSigned Note."
  1. I $P(SIGNDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=SIGNDT Q "Image was attached Same Day as Note was Signed."
  1. I MAGDT>SIGNDT Q "Image was attached After the Note was Signed."
  1. Q "Image was attached Before the Note was Signed."
  1. USERKEYS(MAGK) ; RPC [MAGGUSERKEYS] (called from MAGGTU3)
  1. N Y
  1. N MAGKS ; list of keys to send to XUS KEY CHECK
  1. N MAGKG ; list returned from XUS KEY CHECK
  1. N I,J,MAGMED,MAGKEY,MAGPLC
  1. K MAGK
  1. S MAGPLC=+$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002
  1. S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U)
  1. I 'MAGKEY S MAGK(0)="CAPTURE KEYS OFF"
  1. E S MAGK(0)="CAPTURE KEYS ON"
  1. N X S X="MAG",I=0
  1. F S X=$O(^XUSEC(X)) Q:$E(X,1,3)'="MAG" D
  1. . S I=I+1,MAGKS(I)=X
  1. D OWNSKEY^XUSRB(.MAGKG,.MAGKS)
  1. S I=0,J=0,MAGMED=0
  1. F S I=$O(MAGKG(I)) Q:I="" D
  1. . Q:MAGKG(I)=0
  1. . S J=J+1,MAGK(J)=MAGKS(I)
  1. . I MAGKS(I)["MAGCAP MED" S MAGMED=1
  1. I MAGMED S J=J+1,MAGK(J)="MAGCAP MED"
  1. Q
  1. GETINFO(MAGRY,IEN,MAGFLAGS) ; RPC [MAG4 GET IMAGE INFO]
  1. ; MAGFLAGS Flags that control the execution (can be combined):
  1. ; D Deleted Image Information is relevant
  1. ;
  1. ; Call (3.0p8) to get information on 1 image
  1. ; and Display in the Image Information Window
  1. N Y,J,JI,I,CT,IENC,FLAGS,SNGRP,Z,M40,T,QACHK,OBJTYP,VAL,LBL,MAGFILE,MAGISDEL
  1. S MAGFLAGS=$G(MAGFLAGS)
  1. S I=0,CT=0
  1. S MAGRY(CT)=$S($$ISGRP^MAGGI11(IEN):"Group ID#: "_IEN,1:"Image ID#: "_IEN)
  1. S MAGFILE=2005
  1. S MAGISDEL=$$ISDEL^MAGGI11(IEN)
  1. I MAGISDEL D
  1. . S MAGFILE=$$FILE^MAGGI11(IEN) S:MAGFILE'>0 MAGFILE=2005
  1. . S CT=CT+1,MAGRY(CT)="Deleted By: "_$$GET1^DIQ(MAGFILE,IEN,30,"E")
  1. . S CT=CT+1,MAGRY(CT)="Deleted Reason:"_$$GET1^DIQ(MAGFILE,IEN,30.2,"E")
  1. . S CT=CT+1,MAGRY(CT)="Deleted Date: "_$$GET1^DIQ(MAGFILE,IEN,30.1,"E")
  1. . Q
  1. S M40=$G(^MAG(MAGFILE,IEN,40)),T=$P(M40,"^",3)
  1. S Z=$P($G(^MAG(MAGFILE,IEN,0)),"^",10) ; Get the parent IEN
  1. I Z D
  1. . S CT=CT+1,MAGRY(CT)=" is in Group#: "_Z_" ("_$$CNTIMGS(Z,MAGFLAGS)_" images)"
  1. . I '$$ISDEL^MAGGI11(Z) D
  1. . . D CHK^MAGGSQI(.QACHK,Z) Q:QACHK(0)
  1. . . S CT=CT+1,MAGRY(CT)=" QA Warning - Group#: "_Z_" "_$P(QACHK(0),"^",2)
  1. . . Q
  1. . Q
  1. S OBJTYP=$P(^MAG(MAGFILE,IEN,0),"^",6)
  1. S SNGRP="FLDS"
  1. I (+$O(^MAG(MAGFILE,IEN,1,0)))!(OBJTYP=11)!(OBJTYP=16) D
  1. . S CT=CT+1,MAGRY(CT)=$P($G(^MAG(MAGFILE,IEN,40)),"^",1)_" Group of "_+$$CNTIMGS(IEN,MAGFLAGS)
  1. . S SNGRP="FLDG"
  1. . Q
  1. I 'MAGISDEL D
  1. . K QACHK
  1. . D CHK^MAGGSQI(.QACHK,IEN) I 'QACHK(0) D
  1. . . S CT=CT+1,MAGRY(CT)=" QA Warning - Image#: "_IEN_" "_$P(QACHK(0),"^",2)
  1. N MAGOUT,MAGERR,MAGVAL,PKG
  1. S IENC=IEN_","
  1. S FLAGS="EN"
  1. S I=-1
  1. S PKG=""
  1. F S I=I+1,Z=$T(@SNGRP+I) Q:$P(Z,";",3)="end" D
  1. . S J=$P(Z,";",4),JI=J_";"
  1. . K MAGOUT
  1. . S CT=CT+1,MAGRY(CT)=$P(Z,";",3)
  1. . I J=41 D Q ; Need to compute the Class. Class field in Image File is wrong.
  1. . . S MAGVAL=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^MAG(2005.82,$P(^MAG(2005.83,T,0),"^",2),0),"^",1))
  1. . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
  1. . . Q
  1. . D GETS^DIQ(MAGFILE,IEN,JI,FLAGS,"MAGOUT","MAGERR")
  1. . ; Get Extension from FileRef
  1. . I J=1 S MAGVAL=$P($G(MAGOUT(MAGFILE,IENC,J,"E")),".",2)
  1. . E S MAGVAL=$G(MAGOUT(MAGFILE,IENC,J,"E"))
  1. . S MAGVAL=$TR(MAGVAL,"&","+")
  1. . I J=40 S PKG=MAGVAL
  1. . I ((J>=50)&(J<=54)) D Q
  1. . . I PKG'="LAB" K MAGRY(CT) Q
  1. . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
  1. . . Q
  1. . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
  1. ; Compare Parent Association Date with Date/Time Note Signed.
  1. I $P(^MAG(MAGFILE,IEN,0),"^",10) S IEN=$P(^MAG(MAGFILE,IEN,0),"^",10),MAGFILE=$$FILE^MAGGI11(IEN) S:MAGFILE'>0 MAGFILE=2005
  1. I $P(^MAG(MAGFILE,IEN,2),"^",6)=8925 S CT=CT+1,MAGRY(CT)=$$ATTSTAT^MAGGTU31(IEN)
  1. ;
  1. I (OBJTYP=11),($P($G(^MAG(MAGFILE,IEN,100)),"^",6)="") D
  1. . I MAGFILE=2005.1 S IEN=+$O(^MAG(MAGFILE,"AGP",IEN,"")) Q ; Get IEN of child from AGP index for deleted image
  1. . S X=$O(^MAG(MAGFILE,IEN,1,0))
  1. . S IEN=+$G(^MAG(MAGFILE,IEN,1,X,0))
  1. . Q
  1. I $P($G(^MAG(MAGFILE,IEN,100)),"^",6)]"" D
  1. . I OBJTYP=11 D ; If a Group, get Object Type of First Child
  1. . . S Z=$O(^MAG(MAGFILE,IEN,1,0))
  1. . . I 'Z Q
  1. . . S Z=+$G(^MAG(MAGFILE,IEN,1,Z,0))
  1. . . S OBJTYP=+$P($G(^MAG(MAGFILE,Z,0)),"^",6) ; Object of First Child
  1. . . Q
  1. . S OBJTYP=","_OBJTYP_","
  1. . S LBL="",VAL=""
  1. . I ",3,9,10,12,100,"[OBJTYP S LBL="Image Creation Date: " ; "Acquisition Date";
  1. . I ",15,101,102,103,104,105,"[OBJTYP S LBL="Document Creation Date: "
  1. . I LBL="" S LBL="Image Creation Date: "
  1. . S VAL=$$GET1^DIQ(MAGFILE,IEN,110,"E") S:(VAL="") VAL="N/A"
  1. . S CT=CT+1,MAGRY(CT)=LBL_VAL
  1. . Q
  1. I $$GET1^DIQ(MAGFILE,IEN,112,"I") D Q
  1. . S CT=CT+1,MAGRY(CT)="Controlled Image : "_$$GET1^DIQ(MAGFILE,IEN,112,"E")
  1. . ;S CT=CT+1,MAGRY(CT)="Controlled By : "_$$GET1^DIQ(MAGFILE,IEN,112.2,"E")
  1. . ;S CT=CT+1,MAGRY(CT)="Controlled Date : "_$$GET1^DIQ(MAGFILE,IEN,112.1,"E")
  1. . Q
  1. Q
  1. ;
  1. CNTIMGS(GRPIEN,FLAGS) ; Return number of images in a group
  1. ; GRPIEN = IEN of the group
  1. ; FLAGS = If "D" is included then count the deleted images as well
  1. N CNT,IEN
  1. S CNT=0
  1. I FLAGS["D" D ; Get deleted images count
  1. . S IEN=0
  1. . F S IEN=$O(^MAG(2005.1,"AGP",GRPIEN,IEN)) Q:'IEN S CNT=CNT+1
  1. . Q
  1. S CNT=CNT+$P($G(^MAG(2005,GRPIEN,1,0)),"^",4)
  1. Q CNT
  1. ;
  1. FLDS ;;Format: ;3;;
  1. ;;Extension: ;1;;
  1. FLDG ;;Patient: ;5;;
  1. ;;Desc: ;10;;
  1. ;;Procedure: ;6;;
  1. ;; Date: ;15;;
  1. ;;Class: ;41;;
  1. ;;Package: ;40;;
  1. ;;Type: ;42;;
  1. ;;Proc/Event: ;43;;
  1. ;;Spec/SubSpec: ;44;;
  1. ;;Origin: ;45;;
  1. ;;Accession # ;50;;
  1. ;;Specimen Desc ;51;;
  1. ;;Specimen# ;52;;
  1. ;;Stain ;53;;
  1. ;;Objective ;54;;
  1. ;;Captured on: ;7;;
  1. ;; by: ;8;;
  1. ;;Status: ;113;;
  1. ;;Reason: ;113.3;;
  1. ;;end;;