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

RAMAIN1.m

Go to the documentation of this file.
  1. RAMAIN1 ;HISC/CAH,GJC-Radiology Utility File Maintenance ;10/29/97 13:30
  1. ;;5.0;Radiology/Nuclear Medicine;**15,21**;Mar 16, 1998
  1. ; This routine is a 'helper' routine for 'RAMAIN'.
  1. DSPLNKS ; This subroutine display the links between the wasted/unwasted
  1. ; film size types. This subroutine is called from '4^RAMAIN'.
  1. ; This subroutine is only accessed if the '^RA(78.4,"AW")' xref
  1. ; exists.
  1. N RA,RAFS,RAOUT,X,Y,Z S RAOUT=0
  1. S X=0 F S X=$O(^RA(78.4,"AW",1,X)) Q:X'>0 D
  1. . S RA(0)=$G(^RA(78.4,+X,0)) Q:RA(0)']""
  1. . S RA(1)=$P(RA(0),U),RA(5)=+$P(RA(0),U,5)
  1. . S RA(11)=$P($G(^RA(78.4,RA(5),0)),U)
  1. . I RA(1)]"",(RA(11)]"") D
  1. .. S RAFS("LW",RA(1))=RA(11),RAFS("LU",RA(11))=RA(1)
  1. .. Q
  1. . E D
  1. .. S:RA(11)']"" RAFS("UW",RA(1))=""
  1. .. Q
  1. . Q
  1. S X="" F S X=$O(^RA(78.4,"B",X)) Q:X']"" D
  1. . I '$D(RAFS("LU",X))&('$D(RAFS("LW",X)))&('$D(RAFS("UW",X))) D
  1. .. S RAFS("UU",X)=""
  1. .. Q
  1. . Q
  1. I $D(RAFS("LU"))!($D(RAFS("UU")))!($D(RAFS("UW"))) D
  1. . N X,Y,Y1,Z
  1. . S X(1)="'Unwasted Film Size'",X(2)="'Corresponding Wasted Film Size'"
  1. . S X(0)="Relationship between "_X(1)_" and "_X(2)_":"
  1. . S $P(Y1,"-",($L(X(0))+1))="" D HDR(.X,Y1) ; Print out the list
  1. . F Z(0)="LU","UU","UW" D Q:RAOUT
  1. .. S Z="" F S Z=$O(RAFS(Z(0),Z)) Q:Z']""!(RAOUT) D
  1. ... I Z(0)="LU" D
  1. .... W !?5,Z
  1. .... W ?40,$S($G(RAFS(Z(0),Z))]"":$G(RAFS(Z(0),Z)),1:"Error, missing data")
  1. .... Q
  1. ... I Z(0)="UU" D
  1. .... W !?5,Z
  1. .... W ?40,"unassociated with a 'Wasted Film' type"
  1. .... Q
  1. ... I Z(0)="UW" D
  1. .... W !?5,"*** Error, missing Data ***"
  1. .... W ?40,Z
  1. .... Q
  1. ... D:$Y>(IOSL-4) HDH
  1. ... Q
  1. .. Q
  1. . Q
  1. I $G(RAOUT)=0 D:($Y>5) HDH
  1. Q
  1. HDH ; EOS prompt
  1. S DIR(0)="E" D ^DIR K DIR,DIRUT,DIROUT,DTOUT,DUOUT
  1. S:'+Y RAOUT=1 Q:RAOUT D:$D(X)\10&($D(Y1)) HDR(.X,Y1)
  1. Q
  1. HDR(X,Y1) ; Header
  1. W @IOF,!?(IOM-$L($G(X(0)))\2),$G(X(0)),!
  1. W !?5,$G(X(1)),?40,$G(X(2)),!?(IOM-$L(Y1)\2),Y1,!
  1. Q
  1. 1 ; Set-up/Edit the Examination Status file (72).
  1. N RADATE,RAHDR,RALINE,RANOERR,RAOUT,RAPG
  1. S RADATE=$$FMTE^XLFDT($$DT^XLFDT(),"")
  1. S RAHDR="Data Inconsistency Report For Exam Statuses"
  1. S RANOERR="Exam Status Data Inconsistencies Not Found."
  1. S $P(RALINE,"=",(IOM+1))="",(RAOUT,RAPG)=0
  1. N RAIMGTYI,RAIMGTYJ,RAORDXST S RAORDXST=0
  1. S DIC="^RA(79.2,",DIC(0)="QEAMNZ",DIC("A")="Select an Imaging Type: "
  1. D ^DIC K DIC G:+Y'>0 Q1
  1. ; RAIMGTYI=ien of 79.2, RAIMGTYJ=xternal format of the .01
  1. S RAOUT=0,RAIMGTYI=+Y,RAIMGTYJ=$P(Y,U,2)
  1. F D Q:RAOUT
  1. . K DINUM,DLAYGO,DO W !
  1. . S DIC="^RA(72,",DIC(0)="QEALZ",DLAYGO=72
  1. . S DIC("A")="Select an Examination Status: ",DIC("DR")="7////"_RAIMGTYI
  1. . S DIC("S")="I +$P(^(0),U,7)=RAIMGTYI"
  1. . S RADICW(1)="N RA S RA(0)=^(0),RA(3)=$P(RA(0),U,3) "
  1. . S RADICW(2)="W ?35,""Imaging Type: "",?49,RAIMGTYJ"
  1. . S RADICW(3)=",!?35,""Order: "",?42,RA(3)"
  1. . S DIC("W")=RADICW(1)_RADICW(2)_RADICW(3)
  1. . D ^DIC K DIC,DLAYGO,RADICW
  1. . I +Y'>0 S RAOUT=1 Q
  1. . W:$P(Y(0),U,3)=1 !!?5,"* Reminder * ",$P(Y,U,2)," does NOT need data entered for",!?7,"the 'ASK' and 'REQUIRED' fields. Registration automatically",!?7,"sets cases to this status since its ORDER number is 1.",!
  1. . S (DA,RAXSTIEN)=+Y,DIE="^RA(72,",DR="[RA STATUS ENTRY]" D ^DIE
  1. . I $D(DA) S RAEDT72=$G(^RA(72,DA,0)) I $P(RAEDT72,"^",3)="",$$UP^XLFSTR($P(RAEDT72,"^",5))="Y" D
  1. .. W !!,"`"_$P(RAEDT72,"^")_"' is inactive, but appears on Status Tracking.",!,"This is appropriate if you need to use Status Tracking to process cases in"
  1. .. W !,"this status to complete. However, if you have a large number of historic",!,"cases in this status, it will cause response time problems in Status Tracking."
  1. .. Q
  1. . K %,%X,%Y,C,D0,DA,DE,DI,DIE,DQ,DR,RAEDT72,RAEXST,X,Y
  1. . Q
  1. K %,DTOUT,DUOUT,RAOUT,RAXSTIEN,X,Y
  1. N RADASH S $P(RADASH,"_",10)="",RADASH=" "_RADASH_" "
  1. W @IOF
  1. D XAMORD
  1. S RAOUT=$$EOS^RAUTL5() Q:RAOUT
  1. D PRELIM^RAUTL19(RAIMGTYJ) ; check data consistency
  1. Q1 K C,D,DDH,DUOUT,I,POP,RAXSTIEN
  1. Q
  1. XAMORD ; check order number inconsistency for order # 0,1,9
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W !!?$L(RADASH),"Checking order numbers",!,RADASH,"and Default Next Status used for status progression",RADASH,!?11,"within : ",RAIMGTYJ
  1. S:'$D(RAOUT)#2 RAOUT=0
  1. N I,J,RA0,RA2,RAORDXNM F I=0,1,9 D Q:RAOUT
  1. . Q:($D(^RA(72,"AA",RAIMGTYJ,I))\10)
  1. . N RASTAT S RAORDXST=1
  1. . S RASTAT=$S(I=0:"Cancelled",I=1:"Waiting For Exam",1:"Complete")
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . W !!?5,"Error: A status with order number '"_I_"' to represent"
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . W !?5,"'"_RASTAT_"' is MISSING for this imaging type.",$C(7)
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. ; check that the DEFAULT NEXT STATUS has an ORDER no.
  1. S I=0
  1. F S I=$O(^RA(72,"AA",RAIMGTYJ,I)) Q:'I S J=$O(^(I,0)) I +J S RA0=^RA(72,J,0) D ;should always have subscript 5 ?
  1. . Q:$P(RA0,U,3)=9 ;skip check if COMPLETE status
  1. . S RA2=$G(^RA(72,+$P(RA0,U,2),0))
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . I RA2="" W !!?5,$P(RA0,U),"'s Default Next Status (",$P(RA2,U),")'s record is missing" S RAORDXST=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . I $P(RA2,U,3)="" W !!?5,$P(RA0,U),"'s Default Next Status (",$P(RA2,U),") is missing an ORDER no." S RAORDXST=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. .Q
  1. W:'RAORDXST !!?5,"Required order numbers are in place."
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W !
  1. ; check that exam status 'COMPLETE','WAITING FOR EXAM' and
  1. ; 'CANCELLED' exist
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W !!,RADASH_"Checking Exam Status names"_RADASH,!,?$L(RADASH),"within : ",RAIMGTYJ
  1. S RAORDXNM=0 F I=0,1,9 D Q:RAOUT
  1. . S J=$O(^RA(72,"AA",RAIMGTYJ,I,""))
  1. . I I=0,($P(^RA(72,J,0),U)="CANCELLED") Q
  1. . I I=1,($P(^RA(72,J,0),U)="WAITING FOR EXAM") Q
  1. . I I=9,($P(^RA(72,J,0),U)="COMPLETE") Q
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . W !!?5,"Warning : The status with order number '"_I_"' was"
  1. . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. . W !?5,"named '"_$S(I=0:"CANCELLED",I=1:"WAITING FOR EXAM",1:"COMPLETE")_"', but is now named '",$P(^RA(72,J,0),U),"'",$C(7)
  1. . S RAORDXNM=1
  1. Q:(RAOUT!RAORDXNM)
  1. I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
  1. W !!?5,"Exam Status names check complete"
  1. Q