MAGDLBSR ;WOIFO/LB,MLH - Sort/print for 2006.575 ; 01/30/2004 17:11
;;3.0;IMAGING;**10,11**;14-April-2004
;; +---------------------------------------------------------------+
;; | 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 study uid number and gateway site.
N MAGSUID,MAGIEN,MAGPT
N GWLOC ; -- gateway site number
N KFIXALL ; -- does user hold 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 the 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 main failed image rec, there's a xref prob, so bail
. . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q ; clean up xref
. . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
. . . . Q
. . . ; If entry has been corrected, do not include in sort
. . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
. . . ;Only radiology images!
. . . I $P($G(^MAGD(2006.575,MAGIEN,"TYPE")),U)'="RAD" 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 KFIXALL ; -- does user hold MAGDFIX ALL security key?
N GWLOC ; -- gateway site number
;
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 the 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 main failed image rec, there's a xref prob, so bail
. . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q ; CLEAN UP XREF
. . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
. . . . Q
. . . ; If entry has been corrected, do not include in sort
. . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
. . . ;Only radiology images!
. . . I $P($G(^MAGD(2006.575,MAGIEN,"TYPE")),U)'="RAD" 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
;I 'STOP!'START Q
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
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)="DU",DIR("A")=$G(MESSAGE) D ^DIR
Q Y
ASKDT ;Ask date range
N MESSAGE
S MESSAGE="Enter start date" S STR=$$ADATE
I '$D(DTOUT),'$D(DUOUT)
E K STR,STP Q
Q:'STR
I STR'?7N W "Wrong date format." Q
S MESSAGE="Enter stop date" S STP=$$ADATE
I '$D(DTOUT),'$D(DUOUT)
E K STR,STP Q
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
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[HMAGDLBSR 4845 printed Nov 22, 2024@17:10:49 Page 2
MAGDLBSR ;WOIFO/LB,MLH - Sort/print for 2006.575 ; 01/30/2004 17:11
+1 ;;3.0;IMAGING;**10,11**;14-April-2004
+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
SRT ;Sort the file first by the patient name but only the unique entries.
+1 ;The "F" cross reference uses the study uid number and gateway site.
+2 NEW MAGSUID,MAGIEN,MAGPT
+3 ; -- gateway site number
NEW GWLOC
+4 ; -- does user hold 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 the 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 main failed image rec, there's a xref prob, so bail
+20 ; clean up xref
IF '$DATA(^MAGD(2006.575,MAGIEN,0))
Begin DoDot:4
+21 KILL ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
+22 QUIT
End DoDot:4
QUIT
+23 ; If entry has been corrected, do not include in sort
+24 IF $DATA(^MAGD(2006.575,MAGIEN,"FIXD"))
IF $PIECE(^("FIXD"),"^")
QUIT
+25 ;Only radiology images!
+26 IF $PIECE($GET(^MAGD(2006.575,MAGIEN,"TYPE")),U)'="RAD"
QUIT
+27 SET MAGPT=$PIECE(^MAGD(2006.575,MAGIEN,0),"^",4)
+28 SET ^MAGD(2006.575,"D",MAGPT,MAGIEN)=""
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
SRTDT ;Provide sorting by date entry but only if NOT fixed and by unique suid
+1 NEW MAGSUID,MAGIEN,MAGDT
+2 ; -- does user hold MAGDFIX ALL security key?
NEW KFIXALL
+3 ; -- gateway site number
NEW GWLOC
+4 ;
+5 SET KFIXALL=$$SECKEY^MAGDLB12
+6 if '$DATA(^MAGD(2006.575,"F"))
QUIT
+7 KILL ^MAGD(2006.575,"AD")
+8 SET GWLOC=""
+9 FOR
SET GWLOC=$ORDER(^MAGD(2006.575,"F",GWLOC))
if 'GWLOC
QUIT
Begin DoDot:1
+10 ; if this isn't the user's site, bail unless the user holds the
+11 ; MAGDFIX ALL security key
+12 IF GWLOC'=DUZ(2)
IF 'KFIXALL
QUIT
+13 SET MAGSUID=""
+14 FOR
SET MAGSUID=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID))
if MAGSUID=""
QUIT
Begin DoDot:2
+15 SET MAGIEN=0
+16 FOR
SET MAGIEN=$ORDER(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:3
+17 ; if no main failed image rec, there's a xref prob, so bail
+18 ; CLEAN UP XREF
IF '$DATA(^MAGD(2006.575,MAGIEN,0))
Begin DoDot:4
+19 KILL ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
+20 QUIT
End DoDot:4
QUIT
+21 ; If entry has been corrected, do not include in sort
+22 IF $DATA(^MAGD(2006.575,MAGIEN,"FIXD"))
IF $PIECE(^("FIXD"),"^")
QUIT
+23 ;Only radiology images!
+24 IF $PIECE($GET(^MAGD(2006.575,MAGIEN,"TYPE")),U)'="RAD"
QUIT
+25 if '$DATA(^MAGD(2006.575,MAGIEN,1))
QUIT
+26 SET MAGDT=$PIECE(^MAGD(2006.575,MAGIEN,1),"^",3)
+27 SET ^MAGD(2006.575,"AD",MAGDT,MAGIEN)=""
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
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 ;I 'STOP!'START Q
+7 SET L(0)=2
+8 IF SORT="D"
SET SORT="AD"
Begin DoDot:1
+9 IF $LENGTH($GET(START))>1
IF $LENGTH($GET(STOP))>1
SET FR(0,1)=START
SET TO(0,1)=STOP
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
ADATE() ;date
+1 NEW DIR,X,Y
+2 SET DIR(0)="DU"
SET DIR("A")=$GET(MESSAGE)
DO ^DIR
+3 QUIT Y
ASKDT ;Ask date range
+1 NEW MESSAGE
+2 SET MESSAGE="Enter start date"
SET STR=$$ADATE
+3 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
+4 IF '$TEST
KILL STR,STP
QUIT
+5 if 'STR
QUIT
+6 IF STR'?7N
WRITE "Wrong date format."
QUIT
+7 SET MESSAGE="Enter stop date"
SET STP=$$ADATE
+8 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
+9 IF '$TEST
KILL STR,STP
QUIT
+10 IF STP'?7N
WRITE "Wrong date format."
QUIT
+11 QUIT
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
End DoDot:1
if '$DATA(STR)!'$DATA(STP)
QUIT
+8 SET BY=Y
KILL DIR,X,Y,DTOUT,DIRUT,DTOUT
+9 DO PRTDT(BY,$GET(STR),$GET(STP))
+10 KILL BY,STR,STP
+11 QUIT
