62 lines
4.7 KiB
Mathematica
62 lines
4.7 KiB
Mathematica
DGA4005 ;ALB/MRL - AMIS 401-420 REPORT GENERATION ;01 JAN 1988@2300
|
|
;;5.3;Registration;;Aug 13, 1993
|
|
EN S DGPR=0 D SET
|
|
F I=401:1:420 I $$OKDATE(I) F I1=0:0 S I1=$O(^DG(391.1,I,"D",I1)) Q:'I1 S DGDD(I1)="" S X=$S($D(^DG(391.1,I,"D",I1,"MY",DGA,"A1")):^("A1"),1:""),^UTILITY($J,"DGSEG",I1,I)=X S:'DGEN DGEN=$S($D(^DG(391.1,I,"D",I1,"MY",DGA,0)):^(0),1:"")
|
|
EN1 F I=401:1:420 I $$OKDATE(I) F I1=0:0 S I1=$O(DGDD(I1)) Q:'I1 I '$D(^UTILITY($J,"DGSEG",I1,I)) S ^(I)=""
|
|
F I=0:0 S I=$O(^UTILITY($J,"DGSEG",I)) Q:'I D S
|
|
;Q:DGPR <-- REMOVED
|
|
I $D(^UTILITY($J,"DGSEGP")) K %,D,D1,DGDD,DGDV,DGEN,DGPR,DGTIME,DGWHEN,DIC,I,I1,N,X,Y,^UTILITY($J,"DGSEG") D ^DGA4006
|
|
K DGFL G QUIT^DGA4002
|
|
S D DV^DGA4001,H
|
|
F D=1:1:40 S D1=$S($D(^DD(391.12,D,0)):$P(^(0),"^",1),1:"UNKNOWN ELEMENT") W !,$S(D<10:"0"_D,1:D)_")",?4,$E(D1,1,25),?30,"|" D WR
|
|
D END Q
|
|
WR F N=401:1:420 I $$OKDATE(N) S X=$S($D(^UTILITY($J,"DGSEG",I,N)):+$P(^(N),"^",D),1:0) S:'X X=" " W ?$X,$J(X,4),"|"
|
|
S DGXI=$X W $C(13),$E(DGL,1,DGXI) Q
|
|
H ;
|
|
S Y=DGA X ^DD("DD") W @IOF,!,"AMIS SEGMENTS 401-420, ",Y,", '",$P(DGDV,"^",2),"' DIVISION",!,DGL1
|
|
W !?5,"Segment Number ===>",?30,"|"
|
|
F DGXI=401:1:420 I $$OKDATE(DGXI) W " ",DGXI,"|"
|
|
S DGXI=$X-1 W $C(13),$E(DGL,1,DGXI)
|
|
W !?30,"|"
|
|
F DGXI=401:1:420 I $$OKDATE(DGXI) S DGLAB=$P("SC^SC^SC^SC^SC^SC^SC^SC^SC^SC^SC^SC^POW^AO/^WWI^VA^Medi^NSC^NSC^NSC","^",(DGXI-400)) W:($L(DGLAB)<4) " " W DGLAB W:($L(DGLAB)<3) " " W "|"
|
|
;SC | SC | SC | SC | SC | SC | SC | SC | SC | SC | SC | SC | POW| AO/| WWI| VA |Medi| NSC| NSC| NSC|"
|
|
W !?5,"Data Element",?30,"|"
|
|
F DGXI=401:1:420 I $$OKDATE(DGXI) S DGLAB=$P("100%^90%^80%^70%^60%^50%^40%^30%^20%^10%^0%^Oth^ ^IR^Vet^Pens^caid^'A'^'B'^ 'C'",U,(DGXI-400)) W:($L(DGLAB)<4) " " W DGLAB W:($L(DGLAB)<3) " " W "|"
|
|
;100%| 90%| 80%| 70%| 60%| 50%| 40%| 30%| 20%| 10%| 0% | Oth| | IR | Vet|Pens|caid| 'A'| 'B'| 'C'|"
|
|
S DGXI=$X W $C(13),$E(DGL,1,DGXI)
|
|
W !,DGL1 Q
|
|
END S DGXI=$X W $C(13),$E(DGL,1,DGXI)
|
|
W !,DGL1,!,"FOR EACH SEGMENT BLOCKS SHOULD BALANCE AS FOLLOWS: ",?55,"Sum of BLOCKS 02-15 plus 22-25 plus 30-33 plus 38-40 = BLOCK 01."
|
|
W !?55,"Sum of BLOCKS 11-15 = Sum of BLOCKS 16-19.",!?55,"Sum of BLOCKS 11-15 = Sum of BLOCKS 20-21.",!?55,"Sum of BLOCKS 22-25 = Sum of BLOCKS 26-29.",!?55,"Sum of BLOCKS 30-33 = Sum of BLOCKS 34-37."
|
|
W !?55,"With the exception of Segment 420, BLOCKS 39-40 should always be ZERO.",!
|
|
I $D(DGFL(+DGDV)) W !!,"***","Not able to generate AMIS - Data segments are out of balance for:",!
|
|
I $D(DGFL(+DGDV)) F X=0:0 S X=$O(DGUB(X)) Q:'X W X_$S($O(DGUB(X)):",",1:"")
|
|
W !,DGL1
|
|
S Y=$P(DGEN,"^",5) X ^DD("DD") W !,"Totals last generated on '",Y,"' by '",$S($D(^VA(200,+$P(DGEN,"^",4),0)):$P(^(0),"^",1),1:"UNKNOWN USER"),"'.",?(127-$L(DGWHEN)-1),DGWHEN,! Q
|
|
SET D H^DGUTL S Y=DGTIME X ^DD("DD") S DGWHEN="Report Printed: "_Y,(DGL,DGL1,DGEN)=""
|
|
S DGWIDTH=132 F DGII=401:1:420 S X=$P(^DG(391.1,DGII,0),U,3) I (X>0)&(X<DGA) S DGWIDTH=DGWIDTH-5
|
|
S $P(DGL,"_",(DGWIDTH-1))="",$P(DGL1,"=",DGWIDTH)="" K ^UTILITY($J,"DGSEG") Q
|
|
REP ;Reprint
|
|
D SET S I1=+DGPR,DGDD(I1)="" F I=401:1:420 S X=$S($D(^DG(391.1,I,"D",I1,"MY",DGA,"A1")):^("A1"),1:""),^UTILITY($J,"DGSEG",I1,I)=X I 'DGEN,$D(^DG(391.1,I,"D",I1,"MY",DGA,0)) S DGEN=^(0)
|
|
G EN1
|
|
REP1 G EN
|
|
SAV S DGFLG=0 F DGI=0:0 S DGI=$O(^UTILITY($J,"DGSEG",DGI)) Q:'DGI F DGI1=0:0 S DGI1=$O(^UTILITY($J,"DGSEG",DGI,DGI1)) Q:'DGI1 S DGN=^(DGI1),DGFLG=0 D ^DGA4007,SAV1
|
|
I DGCODFLG=1 F DGDIV=0:0 S DGDIV=$O(DGDIV(DGDIV)) Q:'DGDIV I DGDIV(DGDIV) S DGSEG=401,DGMYR=DGA D QUE^DGGECSA
|
|
K DGSEG,DGDIV,DGMYR
|
|
K DA,DFN,DFN1,DG,DGBLK,DGDATA,DGDATA1,DGDIV,DGDV,DGI,DGI1,DGN,DGN1,DGREG,DGSEG,DGSEGR,DGDATE,DGTIME,DGX,DGX1,DGX2,DGX3,DGXXXD,DGZ,DGZ1,DGZ2,DIC,DINUM,I,J,X,X1,X2,^UTILITY($J,"DGSEG"),^("DGDIS")
|
|
G EN
|
|
SAV1 I '$D(^DG(391.1,DGI,0)) S DIC="^DG(391.1,",(X,DA,DINUM)=DGI,DIC(0)="L" K DD,DO D FILE^DICN
|
|
S:'$D(^DG(391.1,DGI,"D",0)) ^(0)="^391.11P^^" I '$D(^DG(391.1,DGI,"D",DGI1,0)) S DIC="^DG(391.1,"_DGI_",""D"",",DA(1)=DGI,(X,DA,DINUM)=DGI1,DIC(0)="L" K DD,DO D FILE^DICN
|
|
S:'$D(^DG(391.1,DGI,"D",DGI1,"MY",0)) ^(0)="^391.12D^^" I '$D(^DG(391.1,DGI,"D",DGI1,"MY",DGA,0)) S DIC="^DG(391.1,"_DGI_",""D"","_DGI1_",""MY"",",DA(2)=DGI,DA(1)=DGI1,(X,DA,DINUM)=DGA,DIC(0)="L" K DD,DO D FILE^DICN
|
|
I $D(DGFLG) S $P(^DG(391.1,DGI,"D",DGI1,"MY",DGA,0),"^",6)=$S(DGFLG:1,1:0),DGDIV(DGI1)=DGFLG I 'DGFLG S DGFL(DGI1)=""
|
|
D H^DGUTL I $P(^DG(391.1,DGI,"D",DGI1,"MY",DGA,0),"^",2)="" S $P(^(0),"^",2)=DUZ,$P(^(0),"^",3)=DGTIME
|
|
S $P(^DG(391.1,DGI,"D",DGI1,"MY",DGA,0),"^",4)=DUZ,$P(^(0),"^",5)=DGTIME
|
|
W:IO=DGDEV "." S ^DG(391.1,DGI,"D",DGI1,"MY",DGA,"A1")=DGN,DGN="" Q
|
|
OKDATE(SEGMENT) ;
|
|
;NEEDS DGA TO BE DEFINED
|
|
;INACTDT=AMIS SEGMENT INACTIVATION DATE
|
|
N INACTDT,DGFL
|
|
S INACTDT=$S(('$D(^DG(391.1,SEGMENT,0))):0,1:$P(^DG(391.1,SEGMENT,0),"^",3))
|
|
S DGFL=0 I (INACTDT']"")!(INACTDT>DGA) S DGFL=1
|
|
Q DGFL
|