source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDCCSS.m@ 1326

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
 ;