Changeset 636 for FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE2.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/SCHEDULING-SD-SC/SDXACSE2.m
r628 r636 1 SDXACSE2 ; ; 05/28/971 SDXACSE2 ; ;12/25/06 2 2 D DE G BEGIN 3 3 DE S DIE="^SDV(D0,""CS"",",DIC=DIE,DP=409.51,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^SDV(D0,"CS",DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,6) S:%]"" DE(3)=% 5 I $D(^(1)) S %Z=^(1) S %=$P(%Z,U,1) S:%]"" DE(1)=% 6 I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,1) S:%]"" DE(5)=% S %=$P(%Z,U,2) S:%]"" DE(7)=% S %=$P(%Z,U,3) S:%]"" DE(9)=% S %=$P(%Z,U,4) S:%]"" DE(11)=% S %=$P(%Z,U,5) S:%]"" DE(13)=% 4 I $D(^("PR")) S %Z=^("PR") S %=$P(%Z,U,5) S:%]"" DE(1)=% 7 5 K %Z Q 8 6 ; … … 17 15 B G @DQ 18 16 RE G PR:$D(DE(DQ)) D W,TR 19 N I X="" G A:DV'["R",X:'DV,X:D'>0,A17 N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A 20 18 RD G QS:X?."?" I X["^" D D G ^DIE17 21 19 I X="@" D D G Z^DIE2 … … 23 21 T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I W:'$D(DB(DQ)) " "_% G V 24 22 K DDER G X 25 P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) I DV'["*" D ^DICS X=+Y,DIC=DIE G X:X<023 P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0 26 24 G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z 27 25 I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X 28 26 V D @("X"_DQ) K YS 29 Z K DIC("S"),DLAYGO I $D(X),X'=U S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A27 Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A 30 28 X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17 31 29 S X="?BAD" … … 45 43 D ^DIR I 'DDER S %=Y(0),X=Y 46 44 Q 45 SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ)) 46 I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")="" 47 E K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/") 48 Q 49 NKEY W:'$D(ZTQUEUED) "?? Required key field" S X="?BAD" G QS 50 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 47 51 BEGIN S DNM="SDXACSE2",DQ=1 48 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="1;1",DV="SI",DU="",DLB="COMPUTER GENERATED?",DIFLD=11 49 S DE(DW)="C1^SDXACSE2" 50 S DU="1:YES;" 51 S X=1 52 S Y=X 53 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 54 G RD:X="@",Z 55 C1 G C1S:$D(DE(1))[0 K DB S X=DE(1),DIC=DIE 56 K:X ^SDV("AG",DA(1),DA) 57 C1S S X="" Q:DG(DQ)=X K DB S X=DG(DQ),DIC=DIE 58 S:X ^SDV("AG",DA(1),DA)="" 59 Q 60 X1 Q 61 2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 62 X2 I 'SDAPTYPR S Y="@1" 63 Q 64 3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;6",DV="S",DU="",DLB="UNRESOLVED APPT TYPE REASON",DIFLD=6 65 S DU="1:DUAL ELIGIBILITY;2:POSSIBLE COMP & PEN;" 66 S X=SDAPTYPR 67 S Y=X 68 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 69 G RD:X="@",Z 70 X3 Q 71 4 S DQ=5 ;@1 72 5 S DW="PR;1",DV="*P81'X",DU="",DLB="PROCEDURE 1",DIFLD=21 73 S DU="ICPT(" 74 S X=$P(SDCPT(SDJ),U,3) 75 S Y=X 76 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 77 G RD:X="@",Z 78 X5 Q 79 6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 80 X6 I $P(SDCPT(SDJ),U,4)']"" S Y="@99" 81 Q 82 7 S DW="PR;2",DV="*P81'X",DU="",DLB="PROCEDURE 2",DIFLD=22 83 S DU="ICPT(" 84 S X=$P(SDCPT(SDJ),U,4) 85 S Y=X 86 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 87 G RD:X="@",Z 88 X7 Q 89 8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 90 X8 I $P(SDCPT(SDJ),U,5)']"" S Y="@99" 91 Q 92 9 S DW="PR;3",DV="*P81'X",DU="",DLB="PROCEDURE 3",DIFLD=23 93 S DU="ICPT(" 94 S X=$P(SDCPT(SDJ),U,5) 95 S Y=X 96 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 97 G RD:X="@",Z 98 X9 Q 99 10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 100 X10 I $P(SDCPT(SDJ),U,6)']"" S Y="@99" 101 Q 102 11 S DW="PR;4",DV="*P81'X",DU="",DLB="PROCEDURE 4",DIFLD=24 103 S DU="ICPT(" 104 S X=$P(SDCPT(SDJ),U,6) 105 S Y=X 106 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 107 G RD:X="@",Z 108 X11 Q 109 12 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 110 X12 I $P(SDCPT(SDJ),U,7)']"" S Y="@99" 111 Q 112 13 S DW="PR;5",DV="*P81'X",DU="",DLB="PROCEDURE 5",DIFLD=25 52 1 S DW="PR;5",DV="*P81'X",DU="",DLB="PROCEDURE 5",DIFLD=25 113 53 S DU="ICPT(" 114 54 S X=$P(SDCPT(SDJ),U,7) 115 55 S Y=X 116 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)56 S X=Y,DB(DQ)=1,DE(DW,"4/")="" G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 117 57 G RD:X="@",Z 118 X1 3Q119 14 S DQ=15;@99120 15G 1^DIE1758 X1 Q 59 2 S DQ=3 ;@99 60 3 G 1^DIE17
Note:
See TracChangeset
for help on using the changeset viewer.