MAGDCCSS ;WOIFO/MLH - DICOM Correct - Clinical Specialties - Sort/print for 2006.575 ; 06/06/2005 09:13
;;3.0;IMAGING;**10,11,51**;26-August-2005
;; +---------------------------------------------------------------+
;; | 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
;
SRT ;Sort the file first by the patient name but only the unique entries.
;The "F" cross reference uses the gateway site and study uid number.
N MAGSUID,MAGIEN,MAGPT ;
N GWLOC ; -- gateway site
N KFIXALL ; -- does user hold the MAGDFIX ALL security key?
N MAGTYPE ; -- type of image (rad, med, clinspec)
;
S KFIXALL=$$SECKEY^MAGDLB12
Q:'$D(^MAGD(2006.575,"F")) ;nothing to sort
K ^MAGD(2006.575,"D")
S GWLOC=""
F S GWLOC=$O(^MAGD(2006.575,"F",GWLOC)) Q:GWLOC="" D
. ; if this isn't the user's site, bail unless user holds the
. ; MAGDFIX ALL security key
. I GWLOC'=DUZ(2),'KFIXALL Q
. S MAGSUID=""
. F S MAGSUID=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID)) Q:MAGSUID="" D
. . S MAGIEN=0
. . F S MAGIEN=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)) Q:'MAGIEN D
. . . ; if no failed image rec, then there's a xref problem -> bail
. . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q
. . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN) ;clean up x-ref
. . . . Q
. . . ; if entry has already been corrected, do not include in sort
. . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
. . . ;Only Clinical Specialties images!
. . . S MAGTYPE=$P($G(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
. . . I MAGTYPE'="CON" Q
. . . S MAGPT=$P(^MAGD(2006.575,MAGIEN,0),"^",4)
. . . S ^MAGD(2006.575,"D",MAGPT,MAGIEN)=""
. . . Q
. . Q
. Q
Q
;
SRTDT ;Provide sorting by date entry but only if NOT fixed and by unique suid
N MAGSUID,MAGIEN,MAGDT
N GWLOC ; -- gateway site
N KFIXALL ; -- does user hold the MAGDFIX ALL security key?
N MAGTYPE ; -- type of image (rad, med, clinspec)
;
S KFIXALL=$$SECKEY^MAGDLB12
Q:'$D(^MAGD(2006.575,"F"))
K ^MAGD(2006.575,"AD")
S GWLOC=""
F S GWLOC=$O(^MAGD(2006.575,"F",GWLOC)) Q:GWLOC="" D
. ; if this isn't the user's site, bail unless user holds the
. ; MAGDFIX ALL security key
. I GWLOC'=DUZ(2),'KFIXALL Q
. S MAGSUID=""
. F S MAGSUID=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID)) Q:MAGSUID="" D
. . S MAGIEN=0
. . F S MAGIEN=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)) Q:'MAGIEN D
. . . ; if no failed image rec, then there's a xref problem -> bail
. . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q
. . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
. . . . Q
. . . ; if entry has already been corrected, do not include in sort
. . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
. . . ;Only Clinical Specialties images!
. . . S MAGTYPE=$P($G(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
. . . I MAGTYPE'="CON" Q
. . . Q:'$D(^MAGD(2006.575,MAGIEN,1))
. . . S MAGDT=$P(^MAGD(2006.575,MAGIEN,1),"^",3)
. . . S ^MAGD(2006.575,"AD",MAGDT,MAGIEN)=""
. . . Q
. . Q
. Q
Q
;
PRTDT(SORT,START,STOP) ;
;Print entries using the "AD" cross reference (date order)
; OR the "F" cross reference (unique study uid)
I '$D(DUZ) W !,"DUZ variable not defined." Q
I "DF"'[SORT Q ;only the date or unique suid
N DIC,BY,FLDS,L,FR,TO
S L(0)=2
I SORT="D" S SORT="AD" D
. I $L($G(START))>1,$L($G(STOP))>1 S FR(0,1)=START,TO(0,1)=STOP
. Q
S DIC="^MAGD(2006.575,",BY(0)="^MAGD(2006.575,"""_SORT_""","
S FLDS="[MAG FAILED IMAGES]",L=0
D EN1^DIP
Q
;
ADATE() ;date
N DIR,X,Y
S DIR(0)="D^",DIR("A")=$G(MESSAGE) D ^DIR
Q Y
;
ASKDT ;Ask date range
N MESSAGE
S MESSAGE="Enter start date" S STR=$$ADATE
Q:'STR
I STR'?7N W "Wrong date format." Q
S MESSAGE="Enter stop date" S STP=$$ADATE
I STP'?7N W "Wrong date format." Q
Q
;
PRNT ;
N DIR,X,Y,BY
S DIR(0)="S^D:Date;F:Unique Entries"
D ^DIR
Q:"DF"'[Y
I Y="D" D Q:'$D(STR)!'$D(STP)
. D ASKDT Q:'$D(STR)!'$D(STP)
. W !,"Please hold sorting by Date. " D SRTDT
. Q
S BY=Y K DIR,X,Y,DTOUT,DIRUT,DTOUT
D PRTDT(BY,$G(STR),$G(STP))
K BY,STR,STP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDCCSS 4944 printed Apr 09, 2024@21:10:17 Page 2
MAGDCCSS ;WOIFO/MLH - DICOM Correct - Clinical Specialties - Sort/print for 2006.575 ; 06/06/2005 09:13
+1 ;;3.0;IMAGING;**10,11,51**;26-August-2005
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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
+18 ;
SRT ;Sort the file first by the patient name but only the unique entries.
+1 ;The "F" cross reference uses the gateway site and study uid number.
+2 ;
NEW MAGSUID,MAGIEN,MAGPT
+3 ; -- gateway site
NEW GWLOC
+4 ; -- does user hold the MAGDFIX ALL security key?
NEW KFIXALL
+5 ; -- type of image (rad, med, clinspec)
NEW MAGTYPE
+6 ;
+7 SET KFIXALL=$$SECKEY^MAGDLB12
+8 ;nothing to sort
if '$DATA(^MAGD(2006.575,"F"))
QUIT
+9 KILL ^MAGD(2006.575,"D")
+10 SET GWLOC=""
+11 FOR
SET GWLOC=$ORDER(^MAGD(2006.575,"F",GWLOC))
if GWLOC=""
QUIT
Begin DoDot:1
+12 ; if this isn't the user's site, bail unless user holds the
+13 ; MAGDFIX ALL security key
+14 IF GWLOC'=DUZ(2)
IF 'KFIXALL
QUIT
+15 SET MAGSUID=""
+16 FOR
SET MAGSUID=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID))
if MAGSUID=""
QUIT
Begin DoDot:2
+17 SET MAGIEN=0
+18 FOR
SET MAGIEN=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:3
+19 ; if no failed image rec, then there's a xref problem -> bail
+20 IF '$DATA(^MAGD(2006.575,MAGIEN,0))
Begin DoDot:4
+21 ;clean up x-ref
KILL ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
+22 QUIT
End DoDot:4
QUIT
+23 ; if entry has already been corrected, do not include in sort
+24 IF $DATA(^MAGD(2006.575,MAGIEN,"FIXD"))
IF $PIECE(^("FIXD"),"^")
QUIT
+25 ;Only Clinical Specialties images!
+26 SET MAGTYPE=$PIECE($GET(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
+27 IF MAGTYPE'="CON"
QUIT
+28 SET MAGPT=$PIECE(^MAGD(2006.575,MAGIEN,0),"^",4)
+29 SET ^MAGD(2006.575,"D",MAGPT,MAGIEN)=""
+30 QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 QUIT
+34 ;
SRTDT ;Provide sorting by date entry but only if NOT fixed and by unique suid
+1 NEW MAGSUID,MAGIEN,MAGDT
+2 ; -- gateway site
NEW GWLOC
+3 ; -- does user hold the MAGDFIX ALL security key?
NEW KFIXALL
+4 ; -- type of image (rad, med, clinspec)
NEW MAGTYPE
+5 ;
+6 SET KFIXALL=$$SECKEY^MAGDLB12
+7 if '$DATA(^MAGD(2006.575,"F"))
QUIT
+8 KILL ^MAGD(2006.575,"AD")
+9 SET GWLOC=""
+10 FOR
SET GWLOC=$ORDER(^MAGD(2006.575,"F",GWLOC))
if GWLOC=""
QUIT
Begin DoDot:1
+11 ; if this isn't the user's site, bail unless user holds the
+12 ; MAGDFIX ALL security key
+13 IF GWLOC'=DUZ(2)
IF 'KFIXALL
QUIT
+14 SET MAGSUID=""
+15 FOR
SET MAGSUID=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID))
if MAGSUID=""
QUIT
Begin DoDot:2
+16 SET MAGIEN=0
+17 FOR
SET MAGIEN=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:3
+18 ; if no failed image rec, then there's a xref problem -> bail
+19 IF '$DATA(^MAGD(2006.575,MAGIEN,0))
Begin DoDot:4
+20 KILL ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
+21 QUIT
End DoDot:4
QUIT
+22 ; if entry has already been corrected, do not include in sort
+23 IF $DATA(^MAGD(2006.575,MAGIEN,"FIXD"))
IF $PIECE(^("FIXD"),"^")
QUIT
+24 ;Only Clinical Specialties images!
+25 SET MAGTYPE=$PIECE($GET(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
+26 IF MAGTYPE'="CON"
QUIT
+27 if '$DATA(^MAGD(2006.575,MAGIEN,1))
QUIT
+28 SET MAGDT=$PIECE(^MAGD(2006.575,MAGIEN,1),"^",3)
+29 SET ^MAGD(2006.575,"AD",MAGDT,MAGIEN)=""
+30 QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 QUIT
+34 ;
PRTDT(SORT,START,STOP) ;
+1 ;Print entries using the "AD" cross reference (date order)
+2 ; OR the "F" cross reference (unique study uid)
+3 IF '$DATA(DUZ)
WRITE !,"DUZ variable not defined."
QUIT
+4 ;only the date or unique suid
IF "DF"'[SORT
QUIT
+5 NEW DIC,BY,FLDS,L,FR,TO
+6 SET L(0)=2
+7 IF SORT="D"
SET SORT="AD"
Begin DoDot:1
+8 IF $LENGTH($GET(START))>1
IF $LENGTH($GET(STOP))>1
SET FR(0,1)=START
SET TO(0,1)=STOP
+9 QUIT
End DoDot:1
+10 SET DIC="^MAGD(2006.575,"
SET BY(0)="^MAGD(2006.575,"""_SORT_""","
+11 SET FLDS="[MAG FAILED IMAGES]"
SET L=0
+12 DO EN1^DIP
+13 QUIT
+14 ;
ADATE() ;date
+1 NEW DIR,X,Y
+2 SET DIR(0)="D^"
SET DIR("A")=$GET(MESSAGE)
DO ^DIR
+3 QUIT Y
+4 ;
ASKDT ;Ask date range
+1 NEW MESSAGE
+2 SET MESSAGE="Enter start date"
SET STR=$$ADATE
+3 if 'STR
QUIT
+4 IF STR'?7N
WRITE "Wrong date format."
QUIT
+5 SET MESSAGE="Enter stop date"
SET STP=$$ADATE
+6 IF STP'?7N
WRITE "Wrong date format."
QUIT
+7 QUIT
+8 ;
PRNT ;
+1 NEW DIR,X,Y,BY
+2 SET DIR(0)="S^D:Date;F:Unique Entries"
+3 DO ^DIR
+4 if "DF"'[Y
QUIT
+5 IF Y="D"
Begin DoDot:1
+6 DO ASKDT
if '$DATA(STR)!'$DATA(STP)
QUIT
+7 WRITE !,"Please hold sorting by Date. "
DO SRTDT
+8 QUIT
End DoDot:1
if '$DATA(STR)!'$DATA(STP)
QUIT
+9 SET BY=Y
KILL DIR,X,Y,DTOUT,DIRUT,DTOUT
+10 DO PRTDT(BY,$GET(STR),$GET(STP))
+11 KILL BY,STR,STP
+12 QUIT
+13 ;
