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