- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- Location:
- WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED
- Files:
-
- 3 edited
-
XDRDSHOW.m (modified) (1 diff)
-
XTPMKPCF.m (modified) (1 diff)
-
XTPMSTA2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDSHOW.m
r613 r623 1 XDRDSHOW ;SF-IRMFO.SEA/JLI - DISPLAY DATA IN FIELDS, GET OVERWRITES ;01/30/2008 2 ;;7.3;TOOLKIT;**23,49,78,112**;Apr 25, 1995;Build 1 3 ;; 4 SHOW(FILE,REC1,REC2,FLDS,REVIEW) ; 5 N FILDIC,MULT,DDVAL,NAMIEN1,NAMIEN2,NAMREC1,NAMREC2,FIRSTIME,MPIMB 6 S FILDIC=$G(^DIC(FILE,0,"GL")) Q:FILDIC="" 7 S REVIEW=+$G(REVIEW) 8 S FILREC1=FILDIC_"REC1)" 9 S FILREC2=FILDIC_"REC2)" 10 S NAMREC1=$P($G(@FILREC1@(0)),U) I NAMREC1="" Q 11 S NAMREC2=$P($G(@FILREC2@(0)),U) I NAMREC2="" Q 12 I FILE=63 D 13 . S NAMIEN1=+$P(@FILREC1@(0),U,3),NAMIEN2=+$P(@FILREC2@(0),U,3) 14 . S NAMREC1=$P(^DPT(NAMIEN1,0),U),NAMREC2=$P(^DPT(NAMIEN2,0),U) 15 I $P(^DD(FILE,.01,0),U,2)["P" D 16 . N XFIL 17 . S XFIL=+$P($P($G(^DD(FILE,.01,0)),U,2),"P",2) Q:XFIL'>0 18 . S XFIL=$G(^DIC(XFIL,0,"GL")) Q:XFIL="" 19 . S NAMREC1=$P(@(XFIL_NAMREC1_",0)"),U) 20 . S NAMREC2=$P(@(XFIL_NAMREC2_",0)"),U) 21 ; 22 ; recalc CMOR scores 23 I FILE=2,$D(^DD(FILE,991.06)) D 24 . N RGDFN S RGDFN=REC1 D CALC^RGVCCMR2 25 . N RGDFN S RGDFN=REC2 D CALC^RGVCCMR2 26 . Q 27 ; 28 ; check for multiple birth indicator in MPI 29 S FIRSTIME=1 30 I FILE=2 D 31 . I $G(^DPT(REC1,"MPIMB"))="Y"!($G(^DPT(REC2,"MPIMB"))="Y") S MPIMB=1 32 . E S MPIMB=0 33 ; 34 D HEADER 35 LOOP ; 36 S FLD=0 37 F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0 D I NLIN<6 D PAGE Q:$D(DIRUT) D HEADER 38 . I FILE=63,$P($G(^DD(FILE,FLD,0)),U)="NAME" Q ;scrn patient file data. From Lab 39 . I FILE'=2,$P($G(^DD(FILE,FLD,0)),U,2)["P2" Q ;From DINUM pointers. 40 . S DDVAL=$G(^DD(FILE,FLD,0)) 41 . S NODE=$P($P(DDVAL,U,4),";") 42 . S PIECE=$P($P(DDVAL,U,4),";",2) 43 . I PIECE=0 S MULT(FLD)="" 44 . I PIECE>0 D 45 . . S X1=$P($G(@FILREC1@(NODE)),U,PIECE),X1=$$TYPE(X1,$P(DDVAL,U,2),DDVAL,REC1) 46 . . S X2=$P($G(@FILREC2@(NODE)),U,PIECE),X2=$$TYPE(X2,$P(DDVAL,U,2),DDVAL,REC2) 47 . . I X1'=""!(X2'="") D 48 . . . S X0=" " 49 . . . S XN=$P(DDVAL,U) 50 . . . S XDRA=0 51 . . . I X1'=""&(X2'=""),X1'=X2 D 52 . . . . I FILE=2,((FLD=991.01)!(FLD=991.02)) Q ;jds restrict ICN overwrites for MPI 53 . . . . S X0=$S($D(FLDS(FLD)):"||||",1:"****"),NDIFFS=NDIFFS+1,DIFFS(NDIFFS)=FLD,XDRA=1 I REVIEW S NLIN=NLIN-1 54 . . . I 'REVIEW!XDRA D 55 . . . . W ! S NLIN=NLIN-1 56 . . . . F Q:XN=""&(X1="")&(X2="") D 57 . . . . . W !,X0," ",$E(XN,1,20),?30,$E(X1,1,20),?55,$E(X2,1,20) 58 . . . . . S NLIN=NLIN-1 59 . . . . . S X0=" ",XN=$E(XN,21,$L(XN)) 60 . . . . . S X1=$E(X1,21,$L(X1)) 61 . . . . . S X2=$E(X2,21,$L(X2)) 62 MULT I '$D(DIRUT) D 63 . I $G(NDIFFS)>0 D PAGE Q:$D(DIRUT) D HEADER 64 . I $D(MULT) D 65 . . F FLD=0:0 S FLD=$O(MULT(FLD)) Q:FLD'>0 D I NLIN<6 D PAGE Q:$D(DIRUT) D HEADER 66 . . . S DDVAL=^DD(FILE,FLD,0) 67 . . . S NAME=$P(DDVAL,U) 68 . . . S NODE=$P($P(DDVAL,U,4),";") 69 . . . S NOD1=$NA(@FILREC1@(NODE)) 70 . . . S NOD2=$NA(@FILREC2@(NODE)) 71 . . . S N1=0,N2=0 72 . . . F I=0:0 S I=$O(@NOD1@(I)) Q:I'>0 S N1=N1+1 73 . . . F I=0:0 S I=$O(@NOD2@(I)) Q:I'>0 S N2=N2+1 74 . . . I N1'=0!(N2'=0) D 75 . . . . S N1=$S(N1>1:N1_" entries",N1>0:N1_" entry",1:"---") 76 . . . . S N2=$S(N2>1:N2_" entries",N2>0:N2_" entry",1:"---") 77 . . . . W !!,$E(NAME,1,25),?30,N1,?55,N2 78 . . . . S NLIN=NLIN-2 79 Q 80 PAGE ; 81 I IOST'["C-"!$D(ZTQUEUED) Q 82 W ! 83 I '$D(DIFFS)!'REVIEW S DIR(0)="E" D ^DIR K DIR 84 I $D(DIFFS)&REVIEW D 85 . S DIR(0)="LO^1:"_NDIFFS,DIR("A")="OVERWRITE data for selected fields" 86 . F I=1:1:NDIFFS W !,I," ",$P(^DD(FILE,DIFFS(I),0),U) 87 . W ! D ^DIR K DIR 88 . I X="",$D(DIRUT) K DIRUT 89 . S I="" F S I=$O(Y(I)) Q:I="" S Y=Y(I) K Y(I) D 90 . . F Q:Y="," Q:Y="" S X=$D(FLDS(DIFFS(+Y))) K:X=1 FLDS(DIFFS(+Y)) S:X=0 FLDS(DIFFS(+Y))="" S Y=$P(Y,",",2,999) 91 Q 92 ; 93 HEADER ; 94 N REC1MB,REC2MB 95 I '$G(FIRSTIME),$D(IOF) W @IOF 96 I $G(FIRSTIME),$G(MPIMB) D WARNING 97 S FIRSTIME=0 98 K DIFFS S NDIFFS=0 99 S NLIN=IOSL-4 100 I $D(MPIMB) S NLIN=NLIN-4,MPIMB=0 101 I '$D(PACKAGE) S PACKAGE="PRIMARY" 102 ;REM - modified next two lines to include IENs in review display 103 W !,?30,$S(PACKAGE="PRIMARY":"RECORD1 [#"_REC1_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_REC1_"]") 104 W ?55,$S(PACKAGE="PRIMARY":"RECORD2 [#"_REC2_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_REC2_"]") 105 ;I FILE=63 W !?38,"[#"_NAMIEN1_"]",?55,"[#"_NAMIEN2_"]" 106 W !,?30,$E(NAMREC1,1,20),?55,$E(NAMREC2,1,20) 107 S NLIN=NLIN-2 108 I $E(NAMREC1,21,40)'=""!($E(NAMREC2,21,40)'="") D 109 . W !,?30,$E(NAMREC1,21,40),?55,$E(NAMREC2,21,40) 110 . S NLIN=NLIN-1 111 ; 112 ; add CMOR scores to header 113 I $D(^DD(FILE,991.06)) D 114 . W !,?30,"CMOR SCORE = "_$S($P($G(^DPT(REC1,"MPI")),U,6):$P(^DPT(REC1,"MPI"),U,6),1:"NULL"),?55,"CMOR SCORE = "_$S($P($G(^DPT(REC2,"MPI")),U,6):$P(^DPT(REC2,"MPI"),U,6),1:"NULL") 115 . S NLIN=NLIN-1 116 ; 117 ; add MULTIBLE BIRTH indicator to header 118 S (REC1MB,REC2MB)=0 119 I $G(^DPT(REC1,"MPIMB"))="Y" S REC1MB=1 120 I $G(^DPT(REC2,"MPIMB"))="Y" S REC2MB=1 121 I REC1MB!REC2MB D 122 . W !,?30,$S(REC1MB:"**MULTIPLE BIRTH**",1:""),?55,$S(REC2MB:"**MULTIPLE BIRTH**",1:"") 123 . S NLIN=NLIN-1 124 ; 125 W !,"----------------------------------------------------------------------------" 126 S NLIN=NLIN-1 127 Q 128 ; 129 POINT(VAL,FILE) ; 130 N X,Y 131 I +VAL'=VAL Q "BAD POINTER VALUE IN FILE" 132 S Y=$G(^DIC(FILE,0,"GL")) Q:Y="" "" 133 S Y=Y_VAL_",0)" 134 S Y=$P($G(@Y),U) I Y'=""&($P(^DD(FILE,.01,0),U,2)["P") S Y=$$POINT(Y,+$P($P(^DD(FILE,.01,0),U,2),"P",2)) 135 S:Y="" Y="** Missing Entry in File "_FILE_"." ;REM - 9/6/96 When a pointer node is missing. 136 Q Y 137 TYPE(VAL,TYPE,DDNODE0,REC) ; 138 I TYPE["O",$D(^DD(FILE,FLD,2)) S Y=VAL,D0=REC X ^DD(FILE,FLD,2) S VAL=Y Q VAL 139 I TYPE["F",VAL'="" S VAL=""""_VAL_"""" Q VAL 140 I TYPE["P",VAL>0 S VAL=$$POINT(VAL,+$P(TYPE,"P",2)) Q VAL 141 I TYPE["D",VAL>0 D Q VAL 142 . S VAL=$TR($$FMTE^XLFDT(VAL,2),"@"," ") 143 I TYPE["S" D Q VAL 144 . N X S X=";"_$P(DDNODE0,U,3) 145 . S X=$P($P(X,(";"_VAL_":"),2),";") 146 . I X'="" S VAL=X 147 Q VAL 148 ; 149 WARNING ; 150 W !,?2,"*** WARNING!!! One or both of these records indicated MULTIPLE BIRTH. ***",!,?2,"Use caution to ensure that these records are truly duplicates and not",!,?2,"siblings before proceeding.",! 151 Q 1 XDRDSHOW ;SF-IRMFO.SEA/JLI - DISPLAY DATA IN FIELDS, GET OVERWRITES ;02/11/2004 08:56 2 ;;7.3;TOOLKIT;**23,49,78**;Apr 25, 1995 3 ;; 4 SHOW(FILE,REC1,REC2,FLDS,REVIEW) ; 5 N FILDIC,MULT,DDVAL,NAMIEN1,NAMIEN2,NAMREC1,NAMREC2,FIRSTIME,MPIMB 6 S FILDIC=$G(^DIC(FILE,0,"GL")) Q:FILDIC="" 7 S REVIEW=+$G(REVIEW) 8 S FILREC1=FILDIC_"REC1)" 9 S FILREC2=FILDIC_"REC2)" 10 S NAMREC1=$P($G(@FILREC1@(0)),U) I NAMREC1="" Q 11 S NAMREC2=$P($G(@FILREC2@(0)),U) I NAMREC2="" Q 12 I FILE=63 D 13 . S NAMIEN1=+$P(@FILREC1@(0),U,3),NAMIEN2=+$P(@FILREC2@(0),U,3) 14 . S NAMREC1=$P(^DPT(NAMIEN1,0),U),NAMREC2=$P(^DPT(NAMIEN2,0),U) 15 I $P(^DD(FILE,.01,0),U,2)["P" D 16 . N XFIL 17 . S XFIL=+$P($P($G(^DD(FILE,.01,0)),U,2),"P",2) Q:XFIL'>0 18 . S XFIL=$G(^DIC(XFIL,0,"GL")) Q:XFIL="" 19 . S NAMREC1=$P(@(XFIL_NAMREC1_",0)"),U) 20 . S NAMREC2=$P(@(XFIL_NAMREC2_",0)"),U) 21 ; 22 ; recalc CMOR scores 23 I FILE=2,$D(^DD(FILE,991.06)) D 24 . N RGDFN S RGDFN=REC1 D CALC^RGVCCMR2 25 . N RGDFN S RGDFN=REC2 D CALC^RGVCCMR2 26 . Q 27 ; 28 ; check for multiple birth indicator in MPI 29 S FIRSTIME=1 30 I FILE=2 D 31 . I $G(^DPT(REC1,"MPIMB"))="Y"!($G(^DPT(REC2,"MPIMB"))="Y") S MPIMB=1 32 . E S MPIMB=0 33 ; 34 D HEADER 35 LOOP ; 36 S FLD=0 37 F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0 D I NLIN<6 D PAGE Q:$D(DIRUT) D HEADER 38 . I FILE=63,$P($G(^DD(FILE,FLD,0)),U)="NAME" Q ;scrn patient file data. From Lab 39 . I FILE'=2,$P($G(^DD(FILE,FLD,0)),U,2)["P2" Q ;From DINUM pointers. 40 . S DDVAL=$G(^DD(FILE,FLD,0)) 41 . S NODE=$P($P(DDVAL,U,4),";") 42 . S PIECE=$P($P(DDVAL,U,4),";",2) 43 . I PIECE=0 S MULT(FLD)="" 44 . I PIECE>0 D 45 . . S X1=$P($G(@FILREC1@(NODE)),U,PIECE),X1=$$TYPE(X1,$P(DDVAL,U,2),DDVAL,REC1) 46 . . S X2=$P($G(@FILREC2@(NODE)),U,PIECE),X2=$$TYPE(X2,$P(DDVAL,U,2),DDVAL,REC2) 47 . . I X1'=""!(X2'="") D 48 . . . S X0=" " 49 . . . S XN=$P(DDVAL,U) 50 . . . S XDRA=0 51 . . . I X1'=""&(X2'=""),X1'=X2 S X0=$S($D(FLDS(FLD)):"||||",1:"****"),NDIFFS=NDIFFS+1,DIFFS(NDIFFS)=FLD,XDRA=1 I REVIEW S NLIN=NLIN-1 52 . . . I 'REVIEW!XDRA D 53 . . . . W ! S NLIN=NLIN-1 54 . . . . F Q:XN=""&(X1="")&(X2="") D 55 . . . . . W !,X0," ",$E(XN,1,20),?30,$E(X1,1,20),?55,$E(X2,1,20) 56 . . . . . S NLIN=NLIN-1 57 . . . . . S X0=" ",XN=$E(XN,21,$L(XN)) 58 . . . . . S X1=$E(X1,21,$L(X1)) 59 . . . . . S X2=$E(X2,21,$L(X2)) 60 MULT I '$D(DIRUT) D 61 . I $G(NDIFFS)>0 D PAGE Q:$D(DIRUT) D HEADER 62 . I $D(MULT) D 63 . . F FLD=0:0 S FLD=$O(MULT(FLD)) Q:FLD'>0 D I NLIN<6 D PAGE Q:$D(DIRUT) D HEADER 64 . . . S DDVAL=^DD(FILE,FLD,0) 65 . . . S NAME=$P(DDVAL,U) 66 . . . S NODE=$P($P(DDVAL,U,4),";") 67 . . . S NOD1=$NA(@FILREC1@(NODE)) 68 . . . S NOD2=$NA(@FILREC2@(NODE)) 69 . . . S N1=0,N2=0 70 . . . F I=0:0 S I=$O(@NOD1@(I)) Q:I'>0 S N1=N1+1 71 . . . F I=0:0 S I=$O(@NOD2@(I)) Q:I'>0 S N2=N2+1 72 . . . I N1'=0!(N2'=0) D 73 . . . . S N1=$S(N1>1:N1_" entries",N1>0:N1_" entry",1:"---") 74 . . . . S N2=$S(N2>1:N2_" entries",N2>0:N2_" entry",1:"---") 75 . . . . W !!,$E(NAME,1,25),?30,N1,?55,N2 76 . . . . S NLIN=NLIN-2 77 Q 78 PAGE ; 79 I IOST'["C-"!$D(ZTQUEUED) Q 80 W ! 81 I '$D(DIFFS)!'REVIEW S DIR(0)="E" D ^DIR K DIR 82 I $D(DIFFS)&REVIEW D 83 . S DIR(0)="LO^1:"_NDIFFS,DIR("A")="OVERWRITE data for selected fields" 84 . F I=1:1:NDIFFS W !,I," ",$P(^DD(FILE,DIFFS(I),0),U) 85 . W ! D ^DIR K DIR 86 . I X="",$D(DIRUT) K DIRUT 87 . S I="" F S I=$O(Y(I)) Q:I="" S Y=Y(I) K Y(I) D 88 . . F Q:Y="," Q:Y="" S X=$D(FLDS(DIFFS(+Y))) K:X=1 FLDS(DIFFS(+Y)) S:X=0 FLDS(DIFFS(+Y))="" S Y=$P(Y,",",2,999) 89 Q 90 ; 91 HEADER ; 92 N REC1MB,REC2MB 93 I '$G(FIRSTIME),$D(IOF) W @IOF 94 I $G(FIRSTIME),$G(MPIMB) D WARNING 95 S FIRSTIME=0 96 K DIFFS S NDIFFS=0 97 S NLIN=IOSL-4 98 I $D(MPIMB) S NLIN=NLIN-4,MPIMB=0 99 I '$D(PACKAGE) S PACKAGE="PRIMARY" 100 ;REM - modified next two lines to include IENs in review display 101 W !,?30,$S(PACKAGE="PRIMARY":"RECORD1 [#"_REC1_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_REC1_"]") 102 W ?55,$S(PACKAGE="PRIMARY":"RECORD2 [#"_REC2_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_REC2_"]") 103 ;I FILE=63 W !?38,"[#"_NAMIEN1_"]",?55,"[#"_NAMIEN2_"]" 104 W !,?30,$E(NAMREC1,1,20),?55,$E(NAMREC2,1,20) 105 S NLIN=NLIN-2 106 I $E(NAMREC1,21,40)'=""!($E(NAMREC2,21,40)'="") D 107 . W !,?30,$E(NAMREC1,21,40),?55,$E(NAMREC2,21,40) 108 . S NLIN=NLIN-1 109 ; 110 ; add CMOR scores to header 111 I $D(^DD(FILE,991.06)) D 112 . W !,?30,"CMOR SCORE = "_$S($P($G(^DPT(REC1,"MPI")),U,6):$P(^DPT(REC1,"MPI"),U,6),1:"NULL"),?55,"CMOR SCORE = "_$S($P($G(^DPT(REC2,"MPI")),U,6):$P(^DPT(REC2,"MPI"),U,6),1:"NULL") 113 . S NLIN=NLIN-1 114 ; 115 ; add MULTIBLE BIRTH indicator to header 116 S (REC1MB,REC2MB)=0 117 I $G(^DPT(REC1,"MPIMB"))="Y" S REC1MB=1 118 I $G(^DPT(REC2,"MPIMB"))="Y" S REC2MB=1 119 I REC1MB!REC2MB D 120 . W !,?30,$S(REC1MB:"**MULTIPLE BIRTH**",1:""),?55,$S(REC2MB:"**MULTIPLE BIRTH**",1:"") 121 . S NLIN=NLIN-1 122 ; 123 W !,"----------------------------------------------------------------------------" 124 S NLIN=NLIN-1 125 Q 126 ; 127 POINT(VAL,FILE) ; 128 N X,Y 129 I +VAL'=VAL Q "BAD POINTER VALUE IN FILE" 130 S Y=$G(^DIC(FILE,0,"GL")) Q:Y="" "" 131 S Y=Y_VAL_",0)" 132 S Y=$P($G(@Y),U) I Y'=""&($P(^DD(FILE,.01,0),U,2)["P") S Y=$$POINT(Y,+$P($P(^DD(FILE,.01,0),U,2),"P",2)) 133 S:Y="" Y="** Missing Entry in File "_FILE_"." ;REM - 9/6/96 When a pointer node is missing. 134 Q Y 135 TYPE(VAL,TYPE,DDNODE0,REC) ; 136 I TYPE["O",$D(^DD(FILE,FLD,2)) S Y=VAL,D0=REC X ^DD(FILE,FLD,2) S VAL=Y Q VAL 137 I TYPE["F",VAL'="" S VAL=""""_VAL_"""" Q VAL 138 I TYPE["P",VAL>0 S VAL=$$POINT(VAL,+$P(TYPE,"P",2)) Q VAL 139 I TYPE["D",VAL>0 D Q VAL 140 . S VAL=$TR($$FMTE^XLFDT(VAL,2),"@"," ") 141 I TYPE["S" D Q VAL 142 . N X S X=";"_$P(DDNODE0,U,3) 143 . S X=$P($P(X,(";"_VAL_":"),2),";") 144 . I X'="" S VAL=X 145 Q VAL 146 ; 147 WARNING ; 148 W !,?2,"*** WARNING!!! One or both of these records indicated MULTIPLE BIRTH. ***",!,?2,"Use caution to ensure that these records are truly duplicates and not",!,?2,"siblings before proceeding.",! 149 Q -
WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMKPCF.m
r613 r623 1 XTPMKPCF ;OAK/BP - COMPUTED FIELDS AND OTHER ODDITIES FOR PATCH MONITOR; 2 ;;7.3;TOOLKIT;**98,106**; Apr 25, 1995;Build 1 3 ; 4 ; computed fields 5 INSTALL ; returns the patch installation information from the INSTALL file. 6 ; note: Fileman variables are NOT killed because they are used in output. 7 ; read the index backwards and select the last patch reference because TEST 8 ; patches may be involved. If a test patch, null the pointer, like nothing is there. 9 S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X="" 10 S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q 11 S X=$P($G(^XPD(9.7,+X,1)),U,3) 12 I X="" Q 13 S Y=X D DD^%DT S X=$P(Y,"@") K Y 14 Q 15 ; 16 WHO ; returns who installed the patch 17 S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X="" 18 S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" 19 S X=$P($G(^XPD(9.7,+X,0)),U,11) 20 S X=$P($G(^VA(200,+X,0)),U) 21 Q 22 ; 23 ; other utility items 24 ; patch inquiry 25 INQUIRE S IOP="HOME" D ^%ZIS K IOP S $P(DASH,"-",75)="" 26 S HD="Patch Inquiry for "_^DD("SITE") 27 W @IOF,!,HD,!!! K DIC,X,Y 28 S DIC("A")="Enter PATCH NAME: ",DIC="^XPD(9.9,",DIC(0)="AEQM" 29 D ^DIC G:Y<0 EXITI S DA=+Y 30 ; 31 LOOKUP W @IOF,! S DR="0:9",DIQ(0)="C" 32 S DA=+Y W @IOF,HD,!!!!!,DASH D EN1^DIQ W DASH 33 ; 34 CONT W !!!,"Press RETURN to continue or '^' to exit " R ANS:DTIME G:'$T EXITI 35 G:ANS[U EXITI 36 G INQUIRE 37 ; 38 EXITI I IOST?1"C-".E W @IOF,! 39 ; clean up FM vars left 40 K %,%X,A,ANS,D0,D1,D2,DA,DIC,DIK,DL,DX,HD 41 K I,POP,S,DASH,DR,X,Y,DK,DIQ,IOP 42 Q 43 ; 44 PKGLOOK ; used for free-text lookup in monitoring of namespaces 45 N DIC,Y,D0,DO,DA,DICR 46 S DIC(0)="EQM",DIC="^DIC(9.4," D ^DIC 47 I Y<0 K X Q 48 S X=$P($G(^DIC(9.4,+Y,0)),U,2) ; get package prefix 49 Q 50 CMPDTCG ; Compliance Date change 51 K XTBCMDCG 52 S XTBMLN1=$G(^XMB(3.9,XMZ,0)) I XTBMLN1["COMPLIANCE DATE CHANGE" DO 53 .F XTBX=0:0 S XTBX=$O(^XMB(3.9,XMZ,2,XTBX)) Q:XTBX=""!(+XTBX=0) S XTBY=$G(^XMB(3.9,XMZ,2,XTBX,0)) DO 54 ..I XTBY["PATCH " S XTBDESG=$P($P(XTBY,"PATCH ",2)," ",1) Q 55 ..I $D(XTBDESG),XTBY["The Compliance Date for patch"&(XTBY["has been changed to") DO 56 ...S XTBTCMPD=$P(XTBY,"has been changed to ",2) 57 ...S DIC(0)="M",(DIC,DIE)="^XPD(9.9,",X=XTBDESG D ^DIC I Y<0 S XTBX=9999999 Q 58 ...S DA=+Y,DR="8///"_XTBTCMPD D ^DIE 59 ...S XTBCMDCG=1 60 .K DR,DIC,DIE,DA,X,Y,XTBDESG,XTBTCMPD 61 Q 62 ; 63 EXITA D ^%ZISC 64 K ^TMP($J) 65 K XTBDESG,XTBI,XTBINST,XTBINSTX,XTBPKG,XTBPRIO,XTBSEQ,XTBSUB,%ZIS,XTBANS,XTBCOMPD,XTBPURGI 66 K XTBVER,XTBX,XTBY,XTBZ,DIC,DIE,DO,DD,X,XMB,XMER,XMREC,XMRG,XX,XTBXX,XTBHDR,PG,POP,XTBMLN1 67 K XTBDA,XTBLIMIT,XTBLN,XTBPTNM,XTBRECPT,XTBRUNDT,XTBSUBJ,ZTDESC,XTBCNT 68 K XTBX,XTBDTA,XTBDTA,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XTBRCPDT,XTBMG,XTBMGN 69 K XTBINSDA,XTBISTAT,NOFILE,XTBPTYPE,XTBPLVER,XTBPKGPT,XTBPCTVR,YY1 70 K XTBX1,XTBZ,NIGHT,XTBCMPDT,ZTSK,ZTIO,ZTRTN,ZTSAVE 71 Q 72 ; 73 INSDATE ;Print out Installed Date 74 N X,X1 75 S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X="" 76 S X1=$P($G(^XPD(9.9,D0,0)),U,11) I X1>0 W $$FMTE^XLFDT(X1,"2Z") Q 77 S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q 78 S X=$P($G(^XPD(9.7,+X,1)),U,3) W $$FMTE^XLFDT($P(X,"."),"2Z") 79 Q 1 XTPMKPCF ;OAK/BP - COMPUTED FIELDS AND OTHER ODDITIES FOR PATCH MONITOR; [8/9/05 9:23am] 2 ;;7.3;TOOLKIT;**98**; Apr 25, 1995 3 ; 4 ; computed fields 5 INSTALL ; returns the patch installation information from the INSTALL file. 6 ; note: Fileman variables are NOT killed because they are used in output. 7 ; read the index backwards and select the last patch reference because TEST 8 ; patches may be involved. If a test patch, null the pointer, like nothing is there. 9 S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X="" 10 S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" 11 S X=$P($G(^XPD(9.7,+X,1)),U,3) 12 S X=$E(X,1,7) 13 Q 14 ; 15 WHO ; returns who installed the patch 16 S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X="" 17 S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" 18 S X=$P($G(^XPD(9.7,+X,0)),U,11) 19 S X=$P($G(^VA(200,+X,0)),U) 20 Q 21 ; 22 ; other utility items 23 ; patch inquiry 24 INQUIRE S IOP="HOME" D ^%ZIS K IOP S $P(DASH,"-",75)="" 25 S HD="Patch Inquiry for "_^DD("SITE") 26 W @IOF,!,HD,!!! K DIC,X,Y 27 S DIC("A")="Enter PATCH NAME: ",DIC="^XPD(9.9,",DIC(0)="AEQM" 28 D ^DIC G:Y<0 EXITI S DA=+Y 29 ; 30 LOOKUP W @IOF,! S DR="0:9",DIQ(0)="C" 31 S DA=+Y W @IOF,HD,!!!!!,DASH D EN1^DIQ W DASH 32 ; 33 CONT W !!!,"Press RETURN to continue or '^' to exit " R ANS:DTIME G:'$T EXITI 34 G:ANS[U EXITI 35 G INQUIRE 36 ; 37 EXITI I IOST?1"C-".E W @IOF,! 38 ; clean up FM vars left 39 K %,%X,A,ANS,D0,D1,D2,DA,DIC,DIK,DL,DX,HD 40 K I,POP,S,DASH,DR,X,Y,DK,DIQ,IOP 41 Q 42 ; 43 PKGLOOK ; used for free-text lookup in monitoring of namespaces 44 N DIC,Y,D0,DO,DA,DICR 45 S DIC(0)="EQM",DIC="^DIC(9.4," D ^DIC 46 I Y<0 K X Q 47 S X=$P($G(^DIC(9.4,+Y,0)),U,2) ; get package prefix 48 Q 49 CMPDTCG ; Compliance Date change 50 K XTBCMDCG 51 S XTBMLN1=$G(^XMB(3.9,XMZ,0)) I XTBMLN1["COMPLIANCE DATE CHANGE" DO 52 .F XTBX=0:0 S XTBX=$O(^XMB(3.9,XMZ,2,XTBX)) Q:XTBX=""!(+XTBX=0) S XTBY=$G(^XMB(3.9,XMZ,2,XTBX,0)) DO 53 ..I XTBY["PATCH " S XTBDESG=$P($P(XTBY,"PATCH ",2)," ",1) Q 54 ..I $D(XTBDESG),XTBY["The Compliance Date for patch"&(XTBY["has been changed to") DO 55 ...S XTBTCMPD=$P(XTBY,"has been changed to ",2) 56 ...S DIC(0)="M",(DIC,DIE)="^XPD(9.9,",X=XTBDESG D ^DIC I Y<0 S XTBX=9999999 Q 57 ...S DA=+Y,DR="8///"_XTBTCMPD D ^DIE 58 ...S XTBCMDCG=1 59 .K DR,DIC,DIE,DA,X,Y,XTBDESG,XTBTCMPD 60 Q 61 ; 62 EXITA D ^%ZISC 63 K ^TMP($J) 64 K XTBDESG,XTBI,XTBINST,XTBINSTX,XTBPKG,XTBPRIO,XTBSEQ,XTBSUB,%ZIS,XTBANS,XTBCOMPD,XTBPURGI 65 K XTBVER,XTBX,XTBY,XTBZ,DIC,DIE,DO,DD,X,XMB,XMER,XMREC,XMRG,XX,XTBXX,XTBHDR,PG,POP,XTBMLN1 66 K XTBDA,XTBLIMIT,XTBLN,XTBPTNM,XTBRECPT,XTBRUNDT,XTBSUBJ,ZTDESC,XTBCNT 67 K XTBX,XTBDTA,XTBDTA,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XTBRCPDT,XTBMG,XTBMGN 68 K XTBINSDA,XTBISTAT,NOFILE,XTBPTYPE,XTBPLVER,XTBPKGPT,XTBPCTVR,YY1 69 K XTBX1,XTBZ,NIGHT,XTBCMPDT,ZTSK,ZTIO,ZTRTN,ZTSAVE 70 Q -
WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMSTA2.m
r613 r623 1 XTPMSTA2 ;OAK/BP - PRINT PATCH STATISTICS BY COMPLIANCE DATE;2 ;;7.3;TOOLKIT;**98,100,106**; Apr 25, 1995;Build 1 3 4 5 EN 6 7 DATE 8 9 10 11 12 13 DEV 14 15 16 17 18 SORT 19 20 21 22 23 24 25 PRINT 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 ..S Y=XTBINSDT X ^DD("DD") I Y'="" S XTBINSDT=$P(Y,",",1)_","_$E($P(Y,",",2),2,5) ;set date format "MON DD,YYYY" 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 EXIT 60 61 62 63 64 65 66 67 HDR 68 69 70 71 72 73 74 75 76 PAUSE 77 78 79 1 XTPMSTA2 ;OAK/BP - PRINT PATCH STATISTICS BY COMPLIANCE DATE; [1/4/06 9:33am] 2 ;;7.3;TOOLKIT;**98,100**; Apr 25, 1995;Build 4 3 ; 4 S IOP="HOME" D ^%ZIS K IOP 5 EN W @IOF,"Patch Monitor Statistics By Compliance Date",!!! 6 ; 7 DATE W ! S %DT="AEP" 8 S %DT("A")="Enter BEGINNING Compliance date: " D ^%DT G:Y<0 EXIT S XTBBDT=Y X ^DD("DD") S XTBBDT1=Y 9 S %DT="AE",%DT("A")=" and ENDING Compliance date: " D ^%DT G:Y<0 EXIT S XTBEDT=Y X ^DD("DD") S XTBEDT1=Y 10 I XTBEDT<XTBBDT W !!,$C(7),"Starting date is later than ending date.",!! H 2 G DATE 11 W !!,"Do you want to see the patch data" S %=2 D YN^DICN S XTBVIEW=% 12 ; 13 DEV W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT 14 I $D(IO("Q")) S ZTIO=ION,ZTRTN="SORT^XTPMSTA2",ZTSAVE("XTB*")="",ZTDESC="Patch Monitor Statistics By Compliance Date" D ^%ZTLOAD D HOME^%ZIS 15 I $D(ZTSK) W !,"Queued as task #",ZTSK H 2 G EXIT 16 ; 17 ; sort patches by compliance date 18 SORT U IO K ^TMP($J) 19 F XTBCPLDT=(XTBBDT-.0001):0 S XTBCPLDT=$O(^XPD(9.9,"D",XTBCPLDT)) Q:XTBCPLDT=""!(XTBCPLDT>XTBEDT) DO 20 .F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"D",XTBCPLDT,XTBDA)) Q:XTBDA="" DO 21 ..S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA="" 22 ..S XTBPTNAM=$P(XTBDTA,U,1),XTBNMSP=$P($P(XTBDTA,U,4)," - ",1) Q:XTBNMSP="" ;parent package missing in file 23 ..S XTBRELDT=$P(XTBDTA,U,2),XTBPRIOR=$P(XTBDTA,U,3) 24 ..S ^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)=XTBRELDT_U_XTBPRIOR 25 PRINT ; 26 S Y=DT X ^DD("DD") S XTBCURDT=Y 27 K XTBLINE S $P(XTBLINE,"-",(IOM-2))="-" 28 S PG=0 D HDR ; first header 29 S XTBPTNAM="",(XTBTPTCH,XTBTLATE)=0 30 F XTBCPLDT=0:0 S XTBCPLDT=$O(^TMP($J,XTBCPLDT)) Q:XTBCPLDT="" F S XTBPTNAM=$O(^TMP($J,XTBCPLDT,XTBPTNAM)) Q:XTBPTNAM="" DO Q:$D(XTBOUT) 31 .F XTBDA=0:0 S XTBDA=$O(^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)) Q:XTBDA="" DO Q:$D(XTBOUT) 32 ..S XTBTPTCH=XTBTPTCH+1 33 ..S XTBDTA=^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA) 34 ..S XTBRELDT=$P(XTBDTA,U),XTBPRIOR=$P(XTBDTA,U,2) 35 ..S XTBRCVDT=$P($G(^XPD(9.9,XTBDA,0)),U,2) 36 ..S XTBPTYPE=$P($G(^XPD(9.9,XTBDA,0)),U,10) 37 ..I +XTBPTYPE=0 S D0=XTBDA D ^XTPMKPCF S XTBINSDT=X K D0 38 ..I +XTBPTYPE=1 S XTBINSDT=$P($G(^XPD(9.9,XTBDA,0)),U,11) 39 ..I XTBINSDT]"" S X1=XTBINSDT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X 40 ..I XTBINSDT="" S X1=DT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X 41 ..S Y=XTBINSDT X ^DD("DD") S XTBINSDT=Y 42 ..S Y=XTBCPLDT X ^DD("DD") S XTBCPLDX=Y 43 ..S Y=XTBRELDT X ^DD("DD") S XTBRELDT=Y 44 ..S XTBPRIOR=$S(XTBPRIOR="m":"Mandatory",XTBPRIOR="e":"Emergency",1:"Unknown") 45 ..I XTBVIEW=1 W XTBCPLDX,?14,XTBPTNAM,?27,XTBRELDT,?41,XTBINSDT,?55,XTBPRIOR 46 ..I XTBVIEW=1,XTBDAYLT>0 W ?67,$J(XTBDAYLT,3,0)_$S(XTBDAYLT>1:" days",1:" day") 47 ..I XTBDAYLT>0 S XTBTLATE=XTBTLATE+1 48 ..I XTBVIEW=1 W ! I $Y>(IOSL-6),IOST?1"C-".E D PAUSE Q:$D(XTBOUT) 49 ..I XTBVIEW=1 I $Y>(IOSL-6) D HDR 50 G:$D(XTBOUT) EXIT 51 I $Y>(IOSL-6),IOST?1"C-".E D HDR 52 W !!?6,"Totals patches received for date range: ",XTBTPTCH,! 53 W "Total patches installed past compliance date: ",XTBTLATE,!! 54 S XTBDIVOK=0 I XTBTPTCH>0 S XTBDIVOK=1 55 W ?25,"Delinquent patch % : ",$S(XTBDIVOK=1:$J((XTBTLATE/XTBTPTCH*100),6,2),1:100)_" %",! 56 W ?25," Compliance % : ",$S(XTBDIVOK=1:$J(100-(XTBTLATE/XTBTPTCH*100),6,2),1:100)," %",! 57 I IOST?1"C-".E K XTBANS W !!,"Press ENTER to end " R XTBANS:DTIME 58 ; 59 EXIT I IOST?1"C-".E W @IOF,! 60 D ^%ZISC 61 K %,%DT,%ZIS,XTBNMSP,XTBANS,XTBBDT,XTBBDT1,XTBCPLDT,XTBCPLDX,XTBDA,XTBEDT,XTBEDT1,XTBDAYLT 62 K XTBINSDT,XTBLINE,XTBNMSP,XTBOLDNM,XTBNMSP,XTBPTNAM,XTBPTYPE,XTBDTA,XTBGPDA 63 K XTBRCVDT,XTBTLATE,XTBTPTCH,D0,DIC,PG,POP,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%T,%Y 64 K ^TMP($J),XTBOUT,XTBPGF,XTBOLGRP,ZTSK,XTBRELDT,XTBPRIOR,XTBCURDT,XTBDIVOK,XTBVIEW 65 Q 66 ; 67 HDR S PG=PG+1 I IOST?1"P-".E,PG>1 W @IOF 68 I IOST?1"C-".E W @IOF 69 W XTBCURDT S X="Patch Statistical Report for "_^DD("SITE") 70 W ?(IOM-$L(X)\2),X,?(IOM-12),"Page: ",PG,!,?31,"By Compliance Date",! 71 S X="Date range: "_XTBBDT1_" to "_XTBEDT1 W ?(IOM-$L(X)\2),X,! 72 W !,"Compliance",?14,"Patch",?27,"Release",?41,"Install",?67,"# Days",! 73 W "Date",?14,"Number",?27,"Date",?41,"Date",?55,"Priority",?67,"Delinquent",!,XTBLINE,! 74 Q 75 ; 76 PAUSE Q:IOST'?1"C-".E 77 K XTBANS,XTBOUT W !!,"Press ENTER to continue or '^' to end " R XTBANS:DTIME 78 I XTBANS[U!('$T) S (XTBNMSP,XTBPTNAM,XTBCPLDT,XTBDA)="99999999",XTBOUT=1 79 Q
Note:
See TracChangeset
for help on using the changeset viewer.
