- DGA4006 ;ALB/MRL - LIST OF PATIENTS ON AMIS 401-420 SEGMENT ;01 JAN 1988@2300
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- S DGC=0 F I=0:0 S I=$O(^UTILITY($J,"DGSEGP",I)) Q:'I D DV^DGA4001,H F I1=0:0 S I1=$O(^UTILITY($J,"DGSEGP",I,I1)),I2="" D:I1'>0&(DGC) END Q:I1'>0 F I4=0:0 S I2=$O(^UTILITY($J,"DGSEGP",I,I1,I2)) Q:I2="" D 1
- D END:DGC G QUIT^DGA4002
- 1 F I3=0:0 S I3=$O(^UTILITY($J,"DGSEGP",I,I1,I2,I3)) Q:'I3 S X=^(I3),X2=$P(I3,".",2),X1=$E(I3,4,5)_"/"_$E(I3,6,7)_"/"_$E(I3,2,3)_"@"_$E($E(X2,1,2)_"00",1,2)_":"_$E($E(X2,3,4)_"00",1,2) D W
- Q
- W I $Y>$S($D(IOSL):(IOSL-6),1:58) D:DGC END D H
- S DGC=1 W !,I1,?5,I2,?22,$S($P(X,"^",2)]"":$P(X,"^",2),1:"----"),?28,X1,?46,$P(X,"^",4),?60,$P(X,"^",3) S X3=$P(X,"^",1) W ?90,$E(X3,1,$L(X3)-1),?100,$P(X,"^",5) Q
- H W @IOF,!,"PATIENTS INCLUDED ON '",$P(DGDV,"^",2),"' DIVISION, AMIS 401-420 SEGMENTS, " S Y=DGA X ^DD("DD") W Y,!,DGL1
- W !,"SEG",?5,"Patient Name",?22,"SSN4",?28,"Reg Date/Time",?46,"Benefit",?60,"Reg Elig Code",?90,"*Blocks",?100,"Disposition Type",!,DGL1 Q
- END S DGC=0 W !!,DGL1,!,"* - Block 01 (applications received) is presumed for all patients!",!!,"**Dispositions with an UNSCHEDULED status will no longer be counted on this AMIS as of Oct 1, 1989**",! Q
- DGA4006 ;ALB/MRL - LIST OF PATIENTS ON AMIS 401-420 SEGMENT ;01 JAN 1988@2300
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 SET DGC=0
- FOR I=0:0
- SET I=$ORDER(^UTILITY($JOB,"DGSEGP",I))
- IF 'I
- QUIT
- DO DV^DGA4001
- DO H
- FOR I1=0:0
- SET I1=$ORDER(^UTILITY($JOB,"DGSEGP",I,I1))
- SET I2=""
- IF I1'>0&(DGC)
- DO END
- IF I1'>0
- QUIT
- FOR I4=0:0
- SET I2=$ORDER(^UTILITY($JOB,"DGSEGP",I,I1,I2))
- IF I2=""
- QUIT
- DO 1
- +3 IF DGC
- DO END
- GOTO QUIT^DGA4002
- 1 FOR I3=0:0
- SET I3=$ORDER(^UTILITY($JOB,"DGSEGP",I,I1,I2,I3))
- IF 'I3
- QUIT
- SET X=^(I3)
- SET X2=$PIECE(I3,".",2)
- SET X1=$EXTRACT(I3,4,5)_"/"_$EXTRACT(I3,6,7)_"/"_$EXTRACT(I3,2,3)_"@"_$EXTRACT($EXTRACT(X2,1,2)_"00",1,2)_":"_$EXTRACT($EXTRACT(X2,3,4)_"00",1,2)
- DO W
- +1 QUIT
- W IF $Y>$SELECT($DATA(IOSL):(IOSL-6),1:58)
- IF DGC
- DO END
- DO H
- +1 SET DGC=1
- WRITE !,I1,?5,I2,?22,$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:"----"),?28,X1,?46,$PIECE(X,"^",4),?60,$PIECE(X,"^",3)
- SET X3=$PIECE(X,"^",1)
- WRITE ?90,$EXTRACT(X3,1,$LENGTH(X3)-1),?100,$PIECE(X,"^",5)
- QUIT
- H WRITE @IOF,!,"PATIENTS INCLUDED ON '",$PIECE(DGDV,"^",2),"' DIVISION, AMIS 401-420 SEGMENTS, "
- SET Y=DGA
- XECUTE ^DD("DD")
- WRITE Y,!,DGL1
- +1 WRITE !,"SEG",?5,"Patient Name",?22,"SSN4",?28,"Reg Date/Time",?46,"Benefit",?60,"Reg Elig Code",?90,"*Blocks",?100,"Disposition Type",!,DGL1
- QUIT
- END SET DGC=0
- WRITE !!,DGL1,!,"* - Block 01 (applications received) is presumed for all patients!",!!,"**Dispositions with an UNSCHEDULED status will no longer be counted on this AMIS as of Oct 1, 1989**",!
- QUIT
