Index: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDSHOW.m
===================================================================
--- WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDSHOW.m	(revision 613)
+++ WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDSHOW.m	(revision 623)
@@ -1,151 +1,149 @@
-XDRDSHOW	;SF-IRMFO.SEA/JLI - DISPLAY DATA IN FIELDS, GET OVERWRITES ;01/30/2008
-	;;7.3;TOOLKIT;**23,49,78,112**;Apr 25, 1995;Build 1
-	;;
-SHOW(FILE,REC1,REC2,FLDS,REVIEW)	;
-	N FILDIC,MULT,DDVAL,NAMIEN1,NAMIEN2,NAMREC1,NAMREC2,FIRSTIME,MPIMB
-	S FILDIC=$G(^DIC(FILE,0,"GL")) Q:FILDIC=""
-	S REVIEW=+$G(REVIEW)
-	S FILREC1=FILDIC_"REC1)"
-	S FILREC2=FILDIC_"REC2)"
-	S NAMREC1=$P($G(@FILREC1@(0)),U) I NAMREC1="" Q
-	S NAMREC2=$P($G(@FILREC2@(0)),U) I NAMREC2="" Q
-	I FILE=63 D
-	. S NAMIEN1=+$P(@FILREC1@(0),U,3),NAMIEN2=+$P(@FILREC2@(0),U,3)
-	. S NAMREC1=$P(^DPT(NAMIEN1,0),U),NAMREC2=$P(^DPT(NAMIEN2,0),U)
-	I $P(^DD(FILE,.01,0),U,2)["P" D
-	. N XFIL
-	. S XFIL=+$P($P($G(^DD(FILE,.01,0)),U,2),"P",2) Q:XFIL'>0
-	. S XFIL=$G(^DIC(XFIL,0,"GL")) Q:XFIL=""
-	. S NAMREC1=$P(@(XFIL_NAMREC1_",0)"),U)
-	. S NAMREC2=$P(@(XFIL_NAMREC2_",0)"),U)
-	;
-	;   recalc CMOR scores
-	I FILE=2,$D(^DD(FILE,991.06)) D
-	. N RGDFN S RGDFN=REC1 D CALC^RGVCCMR2
-	. N RGDFN S RGDFN=REC2 D CALC^RGVCCMR2
-	. Q
-	; 
-	;   check for multiple birth indicator in MPI
-	S FIRSTIME=1
-	I FILE=2 D
-	. I $G(^DPT(REC1,"MPIMB"))="Y"!($G(^DPT(REC2,"MPIMB"))="Y") S MPIMB=1
-	. E  S MPIMB=0
-	;
-	D HEADER
-LOOP	;
-	S FLD=0
-	F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0  D  I NLIN<6 D PAGE Q:$D(DIRUT)  D HEADER
-	. I FILE=63,$P($G(^DD(FILE,FLD,0)),U)="NAME" Q  ;scrn patient file data. From Lab
-	. I FILE'=2,$P($G(^DD(FILE,FLD,0)),U,2)["P2" Q  ;From DINUM pointers.
-	. S DDVAL=$G(^DD(FILE,FLD,0))
-	. S NODE=$P($P(DDVAL,U,4),";")
-	. S PIECE=$P($P(DDVAL,U,4),";",2)
-	. I PIECE=0 S MULT(FLD)=""
-	. I PIECE>0 D
-	. . S X1=$P($G(@FILREC1@(NODE)),U,PIECE),X1=$$TYPE(X1,$P(DDVAL,U,2),DDVAL,REC1)
-	. . S X2=$P($G(@FILREC2@(NODE)),U,PIECE),X2=$$TYPE(X2,$P(DDVAL,U,2),DDVAL,REC2)
-	. . I X1'=""!(X2'="") D
-	. . . S X0="    "
-	. . . S XN=$P(DDVAL,U)
-	. . . S XDRA=0
-	. . . I X1'=""&(X2'=""),X1'=X2 D
-	. . . . I FILE=2,((FLD=991.01)!(FLD=991.02)) Q  ;jds restrict ICN overwrites for MPI 
-	. . . . S X0=$S($D(FLDS(FLD)):"||||",1:"****"),NDIFFS=NDIFFS+1,DIFFS(NDIFFS)=FLD,XDRA=1 I REVIEW S NLIN=NLIN-1
-	. . . I 'REVIEW!XDRA D
-	. . . . W ! S NLIN=NLIN-1
-	. . . . F  Q:XN=""&(X1="")&(X2="")  D
-	. . . . . W !,X0,"  ",$E(XN,1,20),?30,$E(X1,1,20),?55,$E(X2,1,20)
-	. . . . . S NLIN=NLIN-1
-	. . . . . S X0="    ",XN=$E(XN,21,$L(XN))
-	. . . . . S X1=$E(X1,21,$L(X1))
-	. . . . . S X2=$E(X2,21,$L(X2))
-MULT	I '$D(DIRUT) D
-	. I $G(NDIFFS)>0 D PAGE Q:$D(DIRUT)  D HEADER
-	. I $D(MULT) D
-	. . F FLD=0:0 S FLD=$O(MULT(FLD)) Q:FLD'>0  D  I NLIN<6 D PAGE Q:$D(DIRUT)  D HEADER
-	. . . S DDVAL=^DD(FILE,FLD,0)
-	. . . S NAME=$P(DDVAL,U)
-	. . . S NODE=$P($P(DDVAL,U,4),";")
-	. . . S NOD1=$NA(@FILREC1@(NODE))
-	. . . S NOD2=$NA(@FILREC2@(NODE))
-	. . . S N1=0,N2=0
-	. . . F I=0:0 S I=$O(@NOD1@(I)) Q:I'>0  S N1=N1+1
-	. . . F I=0:0 S I=$O(@NOD2@(I)) Q:I'>0  S N2=N2+1
-	. . . I N1'=0!(N2'=0) D
-	. . . . S N1=$S(N1>1:N1_" entries",N1>0:N1_" entry",1:"---")
-	. . . . S N2=$S(N2>1:N2_" entries",N2>0:N2_" entry",1:"---")
-	. . . . W !!,$E(NAME,1,25),?30,N1,?55,N2
-	. . . . S NLIN=NLIN-2
-	Q
-PAGE	;
-	I IOST'["C-"!$D(ZTQUEUED) Q
-	W !
-	I '$D(DIFFS)!'REVIEW S DIR(0)="E" D ^DIR K DIR
-	I $D(DIFFS)&REVIEW D
-	. S DIR(0)="LO^1:"_NDIFFS,DIR("A")="OVERWRITE data for selected fields"
-	. F I=1:1:NDIFFS W !,I,"  ",$P(^DD(FILE,DIFFS(I),0),U)
-	. W ! D ^DIR K DIR
-	. I X="",$D(DIRUT) K DIRUT
-	. S I="" F  S I=$O(Y(I)) Q:I=""  S Y=Y(I) K Y(I) D
-	. . 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)
-	Q
-	;
-HEADER	;
-	N REC1MB,REC2MB
-	I '$G(FIRSTIME),$D(IOF) W @IOF
-	I $G(FIRSTIME),$G(MPIMB) D WARNING
-	S FIRSTIME=0
-	K DIFFS S NDIFFS=0
-	S NLIN=IOSL-4
-	I $D(MPIMB) S NLIN=NLIN-4,MPIMB=0
-	I '$D(PACKAGE) S PACKAGE="PRIMARY"
-	;REM - modified next two lines to include IENs in review display
-	W !,?30,$S(PACKAGE="PRIMARY":"RECORD1 [#"_REC1_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_REC1_"]")
-	W ?55,$S(PACKAGE="PRIMARY":"RECORD2 [#"_REC2_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_REC2_"]")
-	;I FILE=63 W !?38,"[#"_NAMIEN1_"]",?55,"[#"_NAMIEN2_"]"
-	W !,?30,$E(NAMREC1,1,20),?55,$E(NAMREC2,1,20)
-	S NLIN=NLIN-2
-	I $E(NAMREC1,21,40)'=""!($E(NAMREC2,21,40)'="") D
-	. W !,?30,$E(NAMREC1,21,40),?55,$E(NAMREC2,21,40)
-	. S NLIN=NLIN-1
-	;
-	;   add CMOR scores to header
-	I $D(^DD(FILE,991.06)) D
-	. 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")
-	. S NLIN=NLIN-1
-	;
-	;   add MULTIBLE BIRTH indicator to header
-	S (REC1MB,REC2MB)=0
-	I $G(^DPT(REC1,"MPIMB"))="Y" S REC1MB=1
-	I $G(^DPT(REC2,"MPIMB"))="Y" S REC2MB=1
-	I REC1MB!REC2MB D
-	. W !,?30,$S(REC1MB:"**MULTIPLE BIRTH**",1:""),?55,$S(REC2MB:"**MULTIPLE BIRTH**",1:"")
-	. S NLIN=NLIN-1
-	;
-	W !,"----------------------------------------------------------------------------"
-	S NLIN=NLIN-1
-	Q
-	;
-POINT(VAL,FILE)	;
-	N X,Y
-	I +VAL'=VAL Q "BAD POINTER VALUE IN FILE"
-	S Y=$G(^DIC(FILE,0,"GL")) Q:Y="" ""
-	S Y=Y_VAL_",0)"
-	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))
-	S:Y="" Y="** Missing Entry in File "_FILE_"." ;REM - 9/6/96 When a pointer node is missing. 
-	Q Y
-TYPE(VAL,TYPE,DDNODE0,REC)	;
-	I TYPE["O",$D(^DD(FILE,FLD,2)) S Y=VAL,D0=REC X ^DD(FILE,FLD,2) S VAL=Y Q VAL
-	I TYPE["F",VAL'="" S VAL=""""_VAL_"""" Q VAL
-	I TYPE["P",VAL>0 S VAL=$$POINT(VAL,+$P(TYPE,"P",2)) Q VAL
-	I TYPE["D",VAL>0 D  Q VAL
-	. S VAL=$TR($$FMTE^XLFDT(VAL,2),"@"," ")
-	I TYPE["S" D  Q VAL
-	. N X S X=";"_$P(DDNODE0,U,3)
-	. S X=$P($P(X,(";"_VAL_":"),2),";")
-	. I X'="" S VAL=X
-	Q VAL
-	;
-WARNING	;
-	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.",!
-	Q
+XDRDSHOW ;SF-IRMFO.SEA/JLI - DISPLAY DATA IN FIELDS, GET OVERWRITES ;02/11/2004  08:56
+ ;;7.3;TOOLKIT;**23,49,78**;Apr 25, 1995
+ ;;
+SHOW(FILE,REC1,REC2,FLDS,REVIEW) ;
+ N FILDIC,MULT,DDVAL,NAMIEN1,NAMIEN2,NAMREC1,NAMREC2,FIRSTIME,MPIMB
+ S FILDIC=$G(^DIC(FILE,0,"GL")) Q:FILDIC=""
+ S REVIEW=+$G(REVIEW)
+ S FILREC1=FILDIC_"REC1)"
+ S FILREC2=FILDIC_"REC2)"
+ S NAMREC1=$P($G(@FILREC1@(0)),U) I NAMREC1="" Q
+ S NAMREC2=$P($G(@FILREC2@(0)),U) I NAMREC2="" Q
+ I FILE=63 D
+ . S NAMIEN1=+$P(@FILREC1@(0),U,3),NAMIEN2=+$P(@FILREC2@(0),U,3)
+ . S NAMREC1=$P(^DPT(NAMIEN1,0),U),NAMREC2=$P(^DPT(NAMIEN2,0),U)
+ I $P(^DD(FILE,.01,0),U,2)["P" D
+ . N XFIL
+ . S XFIL=+$P($P($G(^DD(FILE,.01,0)),U,2),"P",2) Q:XFIL'>0
+ . S XFIL=$G(^DIC(XFIL,0,"GL")) Q:XFIL=""
+ . S NAMREC1=$P(@(XFIL_NAMREC1_",0)"),U)
+ . S NAMREC2=$P(@(XFIL_NAMREC2_",0)"),U)
+ ;
+ ;   recalc CMOR scores
+ I FILE=2,$D(^DD(FILE,991.06)) D
+ . N RGDFN S RGDFN=REC1 D CALC^RGVCCMR2
+ . N RGDFN S RGDFN=REC2 D CALC^RGVCCMR2
+ . Q
+ ; 
+ ;   check for multiple birth indicator in MPI
+ S FIRSTIME=1
+ I FILE=2 D
+ . I $G(^DPT(REC1,"MPIMB"))="Y"!($G(^DPT(REC2,"MPIMB"))="Y") S MPIMB=1
+ . E  S MPIMB=0
+ ;
+ D HEADER
+LOOP ;
+ S FLD=0
+ F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0  D  I NLIN<6 D PAGE Q:$D(DIRUT)  D HEADER
+ . I FILE=63,$P($G(^DD(FILE,FLD,0)),U)="NAME" Q  ;scrn patient file data. From Lab
+ . I FILE'=2,$P($G(^DD(FILE,FLD,0)),U,2)["P2" Q  ;From DINUM pointers.
+ . S DDVAL=$G(^DD(FILE,FLD,0))
+ . S NODE=$P($P(DDVAL,U,4),";")
+ . S PIECE=$P($P(DDVAL,U,4),";",2)
+ . I PIECE=0 S MULT(FLD)=""
+ . I PIECE>0 D
+ . . S X1=$P($G(@FILREC1@(NODE)),U,PIECE),X1=$$TYPE(X1,$P(DDVAL,U,2),DDVAL,REC1)
+ . . S X2=$P($G(@FILREC2@(NODE)),U,PIECE),X2=$$TYPE(X2,$P(DDVAL,U,2),DDVAL,REC2)
+ . . I X1'=""!(X2'="") D
+ . . . S X0="    "
+ . . . S XN=$P(DDVAL,U)
+ . . . S XDRA=0
+ . . . 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
+ . . . I 'REVIEW!XDRA D
+ . . . . W ! S NLIN=NLIN-1
+ . . . . F  Q:XN=""&(X1="")&(X2="")  D
+ . . . . . W !,X0,"  ",$E(XN,1,20),?30,$E(X1,1,20),?55,$E(X2,1,20)
+ . . . . . S NLIN=NLIN-1
+ . . . . . S X0="    ",XN=$E(XN,21,$L(XN))
+ . . . . . S X1=$E(X1,21,$L(X1))
+ . . . . . S X2=$E(X2,21,$L(X2))
+MULT I '$D(DIRUT) D
+ . I $G(NDIFFS)>0 D PAGE Q:$D(DIRUT)  D HEADER
+ . I $D(MULT) D
+ . . F FLD=0:0 S FLD=$O(MULT(FLD)) Q:FLD'>0  D  I NLIN<6 D PAGE Q:$D(DIRUT)  D HEADER
+ . . . S DDVAL=^DD(FILE,FLD,0)
+ . . . S NAME=$P(DDVAL,U)
+ . . . S NODE=$P($P(DDVAL,U,4),";")
+ . . . S NOD1=$NA(@FILREC1@(NODE))
+ . . . S NOD2=$NA(@FILREC2@(NODE))
+ . . . S N1=0,N2=0
+ . . . F I=0:0 S I=$O(@NOD1@(I)) Q:I'>0  S N1=N1+1
+ . . . F I=0:0 S I=$O(@NOD2@(I)) Q:I'>0  S N2=N2+1
+ . . . I N1'=0!(N2'=0) D
+ . . . . S N1=$S(N1>1:N1_" entries",N1>0:N1_" entry",1:"---")
+ . . . . S N2=$S(N2>1:N2_" entries",N2>0:N2_" entry",1:"---")
+ . . . . W !!,$E(NAME,1,25),?30,N1,?55,N2
+ . . . . S NLIN=NLIN-2
+ Q
+PAGE ;
+ I IOST'["C-"!$D(ZTQUEUED) Q
+ W !
+ I '$D(DIFFS)!'REVIEW S DIR(0)="E" D ^DIR K DIR
+ I $D(DIFFS)&REVIEW D
+ . S DIR(0)="LO^1:"_NDIFFS,DIR("A")="OVERWRITE data for selected fields"
+ . F I=1:1:NDIFFS W !,I,"  ",$P(^DD(FILE,DIFFS(I),0),U)
+ . W ! D ^DIR K DIR
+ . I X="",$D(DIRUT) K DIRUT
+ . S I="" F  S I=$O(Y(I)) Q:I=""  S Y=Y(I) K Y(I) D
+ . . 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)
+ Q
+ ;
+HEADER ;
+ N REC1MB,REC2MB
+ I '$G(FIRSTIME),$D(IOF) W @IOF
+ I $G(FIRSTIME),$G(MPIMB) D WARNING
+ S FIRSTIME=0
+ K DIFFS S NDIFFS=0
+ S NLIN=IOSL-4
+ I $D(MPIMB) S NLIN=NLIN-4,MPIMB=0
+ I '$D(PACKAGE) S PACKAGE="PRIMARY"
+ ;REM - modified next two lines to include IENs in review display
+ W !,?30,$S(PACKAGE="PRIMARY":"RECORD1 [#"_REC1_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_REC1_"]")
+ W ?55,$S(PACKAGE="PRIMARY":"RECORD2 [#"_REC2_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_REC2_"]")
+ ;I FILE=63 W !?38,"[#"_NAMIEN1_"]",?55,"[#"_NAMIEN2_"]"
+ W !,?30,$E(NAMREC1,1,20),?55,$E(NAMREC2,1,20)
+ S NLIN=NLIN-2
+ I $E(NAMREC1,21,40)'=""!($E(NAMREC2,21,40)'="") D
+ . W !,?30,$E(NAMREC1,21,40),?55,$E(NAMREC2,21,40)
+ . S NLIN=NLIN-1
+ ;
+ ;   add CMOR scores to header
+ I $D(^DD(FILE,991.06)) D
+ . 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")
+ . S NLIN=NLIN-1
+ ;
+ ;   add MULTIBLE BIRTH indicator to header
+ S (REC1MB,REC2MB)=0
+ I $G(^DPT(REC1,"MPIMB"))="Y" S REC1MB=1
+ I $G(^DPT(REC2,"MPIMB"))="Y" S REC2MB=1
+ I REC1MB!REC2MB D
+ . W !,?30,$S(REC1MB:"**MULTIPLE BIRTH**",1:""),?55,$S(REC2MB:"**MULTIPLE BIRTH**",1:"")
+ . S NLIN=NLIN-1
+ ;
+ W !,"----------------------------------------------------------------------------"
+ S NLIN=NLIN-1
+ Q
+ ;
+POINT(VAL,FILE) ;
+ N X,Y
+ I +VAL'=VAL Q "BAD POINTER VALUE IN FILE"
+ S Y=$G(^DIC(FILE,0,"GL")) Q:Y="" ""
+ S Y=Y_VAL_",0)"
+ 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))
+ S:Y="" Y="** Missing Entry in File "_FILE_"." ;REM - 9/6/96 When a pointer node is missing. 
+ Q Y
+TYPE(VAL,TYPE,DDNODE0,REC) ;
+ I TYPE["O",$D(^DD(FILE,FLD,2)) S Y=VAL,D0=REC X ^DD(FILE,FLD,2) S VAL=Y Q VAL
+ I TYPE["F",VAL'="" S VAL=""""_VAL_"""" Q VAL
+ I TYPE["P",VAL>0 S VAL=$$POINT(VAL,+$P(TYPE,"P",2)) Q VAL
+ I TYPE["D",VAL>0 D  Q VAL
+ . S VAL=$TR($$FMTE^XLFDT(VAL,2),"@"," ")
+ I TYPE["S" D  Q VAL
+ . N X S X=";"_$P(DDNODE0,U,3)
+ . S X=$P($P(X,(";"_VAL_":"),2),";")
+ . I X'="" S VAL=X
+ Q VAL
+ ;
+WARNING ;
+ 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.",!
+ Q
Index: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMKPCF.m
===================================================================
--- WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMKPCF.m	(revision 613)
+++ WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMKPCF.m	(revision 623)
@@ -1,79 +1,70 @@
-XTPMKPCF	;OAK/BP - COMPUTED FIELDS AND OTHER ODDITIES FOR PATCH MONITOR;
-	;;7.3;TOOLKIT;**98,106**; Apr 25, 1995;Build 1
-	;
-	; computed fields
-INSTALL	; returns the patch installation information from the INSTALL file.
-	; note: Fileman variables are NOT killed because they are used in output.
-	; read the index backwards and select the last patch reference because TEST
-	;   patches may be involved.  If a test patch, null the pointer, like nothing is there.
-	S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
-	S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q
-	S X=$P($G(^XPD(9.7,+X,1)),U,3)
-	I X="" Q
-	S Y=X D DD^%DT S X=$P(Y,"@") K Y
-	Q
-	;
-WHO	; returns who installed the patch
-	S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
-	S X=$O(^XPD(9.7,"B",X,9999999999),-1)  I $G(^XPD(9.7,+X,2))["TEST v" S X=""
-	S X=$P($G(^XPD(9.7,+X,0)),U,11)
-	S X=$P($G(^VA(200,+X,0)),U)
-	Q
-	;
-	; other utility items
-	; patch inquiry
-INQUIRE	S IOP="HOME" D ^%ZIS K IOP S $P(DASH,"-",75)=""
-	S HD="Patch Inquiry for "_^DD("SITE")
-	W @IOF,!,HD,!!! K DIC,X,Y
-	S DIC("A")="Enter PATCH NAME: ",DIC="^XPD(9.9,",DIC(0)="AEQM"
-	D ^DIC G:Y<0 EXITI S DA=+Y
-	;
-LOOKUP	W @IOF,! S DR="0:9",DIQ(0)="C"
-	S DA=+Y W @IOF,HD,!!!!!,DASH D EN1^DIQ W DASH
-	;
-CONT	W !!!,"Press RETURN to continue or '^' to exit  " R ANS:DTIME G:'$T EXITI
-	G:ANS[U EXITI
-	G INQUIRE
-	;
-EXITI	I IOST?1"C-".E W @IOF,!
-	; clean up FM vars left
-	K %,%X,A,ANS,D0,D1,D2,DA,DIC,DIK,DL,DX,HD
-	K I,POP,S,DASH,DR,X,Y,DK,DIQ,IOP
-	Q
-	;
-PKGLOOK	; used for free-text lookup in monitoring of namespaces
-	N DIC,Y,D0,DO,DA,DICR
-	S DIC(0)="EQM",DIC="^DIC(9.4," D ^DIC
-	I Y<0 K X Q
-	S X=$P($G(^DIC(9.4,+Y,0)),U,2) ; get package prefix
-	Q
-CMPDTCG	; Compliance Date change
-	K XTBCMDCG
-	S XTBMLN1=$G(^XMB(3.9,XMZ,0)) I XTBMLN1["COMPLIANCE DATE CHANGE" DO
-	.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
-	..I XTBY["PATCH " S XTBDESG=$P($P(XTBY,"PATCH ",2)," ",1) Q
-	..I $D(XTBDESG),XTBY["The Compliance Date for patch"&(XTBY["has been changed to") DO
-	...S XTBTCMPD=$P(XTBY,"has been changed to ",2)
-	...S DIC(0)="M",(DIC,DIE)="^XPD(9.9,",X=XTBDESG D ^DIC I Y<0 S XTBX=9999999 Q
-	...S DA=+Y,DR="8///"_XTBTCMPD D ^DIE
-	...S XTBCMDCG=1
-	.K DR,DIC,DIE,DA,X,Y,XTBDESG,XTBTCMPD
-	Q
-	;
-EXITA	D ^%ZISC
-	K ^TMP($J)
-	K XTBDESG,XTBI,XTBINST,XTBINSTX,XTBPKG,XTBPRIO,XTBSEQ,XTBSUB,%ZIS,XTBANS,XTBCOMPD,XTBPURGI
-	K XTBVER,XTBX,XTBY,XTBZ,DIC,DIE,DO,DD,X,XMB,XMER,XMREC,XMRG,XX,XTBXX,XTBHDR,PG,POP,XTBMLN1
-	K XTBDA,XTBLIMIT,XTBLN,XTBPTNM,XTBRECPT,XTBRUNDT,XTBSUBJ,ZTDESC,XTBCNT
-	K XTBX,XTBDTA,XTBDTA,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XTBRCPDT,XTBMG,XTBMGN
-	K XTBINSDA,XTBISTAT,NOFILE,XTBPTYPE,XTBPLVER,XTBPKGPT,XTBPCTVR,YY1
-	K XTBX1,XTBZ,NIGHT,XTBCMPDT,ZTSK,ZTIO,ZTRTN,ZTSAVE
-	Q
-	;
-INSDATE	;Print out Installed Date
-	N X,X1
-	S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
-	S X1=$P($G(^XPD(9.9,D0,0)),U,11) I X1>0 W $$FMTE^XLFDT(X1,"2Z") Q
-	S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q
-	S X=$P($G(^XPD(9.7,+X,1)),U,3) W $$FMTE^XLFDT($P(X,"."),"2Z")
-	Q
+XTPMKPCF ;OAK/BP - COMPUTED FIELDS AND OTHER ODDITIES FOR PATCH MONITOR; [8/9/05 9:23am]
+ ;;7.3;TOOLKIT;**98**; Apr 25, 1995
+ ;
+ ; computed fields
+INSTALL ; returns the patch installation information from the INSTALL file.
+ ; note: Fileman variables are NOT killed because they are used in output.
+ ; read the index backwards and select the last patch reference because TEST
+ ;   patches may be involved.  If a test patch, null the pointer, like nothing is there.
+ S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
+ S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X=""
+ S X=$P($G(^XPD(9.7,+X,1)),U,3)
+ S X=$E(X,1,7)
+ Q
+ ;
+WHO ; returns who installed the patch
+ S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
+ S X=$O(^XPD(9.7,"B",X,9999999999),-1)  I $G(^XPD(9.7,+X,2))["TEST v" S X=""
+ S X=$P($G(^XPD(9.7,+X,0)),U,11)
+ S X=$P($G(^VA(200,+X,0)),U)
+ Q
+ ;
+ ; other utility items
+ ; patch inquiry
+INQUIRE S IOP="HOME" D ^%ZIS K IOP S $P(DASH,"-",75)=""
+ S HD="Patch Inquiry for "_^DD("SITE")
+ W @IOF,!,HD,!!! K DIC,X,Y
+ S DIC("A")="Enter PATCH NAME: ",DIC="^XPD(9.9,",DIC(0)="AEQM"
+ D ^DIC G:Y<0 EXITI S DA=+Y
+ ;
+LOOKUP W @IOF,! S DR="0:9",DIQ(0)="C"
+ S DA=+Y W @IOF,HD,!!!!!,DASH D EN1^DIQ W DASH
+ ;
+CONT W !!!,"Press RETURN to continue or '^' to exit  " R ANS:DTIME G:'$T EXITI
+ G:ANS[U EXITI
+ G INQUIRE
+ ;
+EXITI I IOST?1"C-".E W @IOF,!
+ ; clean up FM vars left
+ K %,%X,A,ANS,D0,D1,D2,DA,DIC,DIK,DL,DX,HD
+ K I,POP,S,DASH,DR,X,Y,DK,DIQ,IOP
+ Q
+ ;
+PKGLOOK ; used for free-text lookup in monitoring of namespaces
+ N DIC,Y,D0,DO,DA,DICR
+ S DIC(0)="EQM",DIC="^DIC(9.4," D ^DIC
+ I Y<0 K X Q
+ S X=$P($G(^DIC(9.4,+Y,0)),U,2) ; get package prefix
+ Q
+CMPDTCG ; Compliance Date change
+ K XTBCMDCG
+ S XTBMLN1=$G(^XMB(3.9,XMZ,0)) I XTBMLN1["COMPLIANCE DATE CHANGE" DO
+ .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
+ ..I XTBY["PATCH " S XTBDESG=$P($P(XTBY,"PATCH ",2)," ",1) Q
+ ..I $D(XTBDESG),XTBY["The Compliance Date for patch"&(XTBY["has been changed to") DO
+ ...S XTBTCMPD=$P(XTBY,"has been changed to ",2)
+ ...S DIC(0)="M",(DIC,DIE)="^XPD(9.9,",X=XTBDESG D ^DIC I Y<0 S XTBX=9999999 Q
+ ...S DA=+Y,DR="8///"_XTBTCMPD D ^DIE
+ ...S XTBCMDCG=1
+ .K DR,DIC,DIE,DA,X,Y,XTBDESG,XTBTCMPD
+ Q
+ ;
+EXITA D ^%ZISC
+ K ^TMP($J)
+ K XTBDESG,XTBI,XTBINST,XTBINSTX,XTBPKG,XTBPRIO,XTBSEQ,XTBSUB,%ZIS,XTBANS,XTBCOMPD,XTBPURGI
+ K XTBVER,XTBX,XTBY,XTBZ,DIC,DIE,DO,DD,X,XMB,XMER,XMREC,XMRG,XX,XTBXX,XTBHDR,PG,POP,XTBMLN1
+ K XTBDA,XTBLIMIT,XTBLN,XTBPTNM,XTBRECPT,XTBRUNDT,XTBSUBJ,ZTDESC,XTBCNT
+ K XTBX,XTBDTA,XTBDTA,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XTBRCPDT,XTBMG,XTBMGN
+ K XTBINSDA,XTBISTAT,NOFILE,XTBPTYPE,XTBPLVER,XTBPKGPT,XTBPCTVR,YY1
+ K XTBX1,XTBZ,NIGHT,XTBCMPDT,ZTSK,ZTIO,ZTRTN,ZTSAVE
+ Q
Index: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMSTA2.m
===================================================================
--- WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMSTA2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMSTA2.m	(revision 623)
@@ -1,79 +1,79 @@
-XTPMSTA2	;OAK/BP - PRINT PATCH STATISTICS BY COMPLIANCE DATE;
-	;;7.3;TOOLKIT;**98,100,106**; Apr 25, 1995;Build 1
-	;
-	S IOP="HOME" D ^%ZIS K IOP
-EN	W @IOF,"Patch Monitor Statistics By Compliance Date",!!!
-	;
-DATE	W ! S %DT="AEP"
-	S %DT("A")="Enter BEGINNING Compliance date: " D ^%DT G:Y<0 EXIT S XTBBDT=Y X ^DD("DD") S XTBBDT1=Y
-	S %DT="AE",%DT("A")="     and ENDING Compliance date: " D ^%DT G:Y<0 EXIT S XTBEDT=Y X ^DD("DD") S XTBEDT1=Y
-	I XTBEDT<XTBBDT W !!,$C(7),"Starting date is later than ending date.",!! H 2 G DATE
-	W !!,"Do you want to see the patch data" S %=2 D YN^DICN S XTBVIEW=%
-	;
-DEV	W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT
-	I $D(IO("Q")) S ZTIO=ION,ZTRTN="SORT^XTPMSTA2",ZTSAVE("XTB*")="",ZTDESC="Patch Monitor Statistics By Compliance Date" D ^%ZTLOAD D HOME^%ZIS
-	I $D(ZTSK) W !,"Queued as task #",ZTSK H 2 G EXIT
-	;
-	; sort patches by compliance date
-SORT	U IO K ^TMP($J)
-	F XTBCPLDT=(XTBBDT-.0001):0 S XTBCPLDT=$O(^XPD(9.9,"D",XTBCPLDT)) Q:XTBCPLDT=""!(XTBCPLDT>XTBEDT)  DO
-	.F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"D",XTBCPLDT,XTBDA)) Q:XTBDA=""  DO
-	..S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
-	..S XTBPTNAM=$P(XTBDTA,U,1),XTBNMSP=$P($P(XTBDTA,U,4)," - ",1) Q:XTBNMSP=""  ;parent package missing in file
-	..S XTBRELDT=$P(XTBDTA,U,2),XTBPRIOR=$P(XTBDTA,U,3)
-	..S ^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)=XTBRELDT_U_XTBPRIOR
-PRINT	; 
-	S Y=DT X ^DD("DD") S XTBCURDT=Y
-	K XTBLINE S $P(XTBLINE,"-",(IOM-2))="-"
-	S PG=0 D HDR ; first header
-	S XTBPTNAM="",(XTBTPTCH,XTBTLATE)=0
-	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)
-	.F XTBDA=0:0 S XTBDA=$O(^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)) Q:XTBDA=""  DO  Q:$D(XTBOUT)
-	..S XTBTPTCH=XTBTPTCH+1
-	..S XTBDTA=^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)
-	..S XTBRELDT=$P(XTBDTA,U),XTBPRIOR=$P(XTBDTA,U,2)
-	..S XTBRCVDT=$P($G(^XPD(9.9,XTBDA,0)),U,2)
-	..S XTBPTYPE=$P($G(^XPD(9.9,XTBDA,0)),U,10)
-	..I +XTBPTYPE=0 S D0=XTBDA D ^XTPMKPCF S XTBINSDT=X K D0
-	..I +XTBPTYPE=1 S XTBINSDT=$P($G(^XPD(9.9,XTBDA,0)),U,11)
-	..I XTBINSDT]"" S X1=XTBINSDT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
-	..I XTBINSDT="" S X1=DT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
-	..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"
-	..S Y=XTBCPLDT X ^DD("DD") S XTBCPLDX=Y
-	..S Y=XTBRELDT X ^DD("DD") S XTBRELDT=Y
-	..S XTBPRIOR=$S(XTBPRIOR="m":"Mandatory",XTBPRIOR="e":"Emergency",1:"Unknown")
-	..I XTBVIEW=1 W XTBCPLDX,?14,XTBPTNAM,?27,XTBRELDT,?41,XTBINSDT,?55,XTBPRIOR
-	..I XTBVIEW=1,XTBDAYLT>0 W ?67,$J(XTBDAYLT,3,0)_$S(XTBDAYLT>1:" days",1:" day")
-	..I XTBDAYLT>0 S XTBTLATE=XTBTLATE+1
-	..I XTBVIEW=1 W ! I $Y>(IOSL-6),IOST?1"C-".E D PAUSE Q:$D(XTBOUT)
-	..I XTBVIEW=1 I $Y>(IOSL-6) D HDR
-	G:$D(XTBOUT) EXIT
-	I $Y>(IOSL-6),IOST?1"C-".E D HDR
-	W !!?6,"Totals patches received for date range: ",XTBTPTCH,!
-	W "Total patches installed past compliance date: ",XTBTLATE,!!
-	S XTBDIVOK=0 I XTBTPTCH>0 S XTBDIVOK=1
-	W ?25,"Delinquent patch % : ",$S(XTBDIVOK=1:$J((XTBTLATE/XTBTPTCH*100),6,2),1:100)_" %",!
-	W ?25,"      Compliance % : ",$S(XTBDIVOK=1:$J(100-(XTBTLATE/XTBTPTCH*100),6,2),1:100)," %",!
-	I IOST?1"C-".E K XTBANS W !!,"Press ENTER to end " R XTBANS:DTIME
-	;
-EXIT	I IOST?1"C-".E W @IOF,!
-	D ^%ZISC
-	K %,%DT,%ZIS,XTBNMSP,XTBANS,XTBBDT,XTBBDT1,XTBCPLDT,XTBCPLDX,XTBDA,XTBEDT,XTBEDT1,XTBDAYLT
-	K XTBINSDT,XTBLINE,XTBNMSP,XTBOLDNM,XTBNMSP,XTBPTNAM,XTBPTYPE,XTBDTA,XTBGPDA
-	K XTBRCVDT,XTBTLATE,XTBTPTCH,D0,DIC,PG,POP,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%T,%Y
-	K ^TMP($J),XTBOUT,XTBPGF,XTBOLGRP,ZTSK,XTBRELDT,XTBPRIOR,XTBCURDT,XTBDIVOK,XTBVIEW
-	Q
-	;
-HDR	S PG=PG+1 I IOST?1"P-".E,PG>1 W @IOF
-	I IOST?1"C-".E W @IOF
-	W XTBCURDT S X="Patch Statistical Report for "_^DD("SITE")
-	W ?(IOM-$L(X)\2),X,?(IOM-12),"Page: ",PG,!,?31,"By Compliance Date",!
-	S X="Date range: "_XTBBDT1_" to "_XTBEDT1 W ?(IOM-$L(X)\2),X,!
-	W !,"Compliance",?14,"Patch",?27,"Release",?41,"Install",?67,"# Days",!
-	W "Date",?14,"Number",?27,"Date",?41,"Date",?55,"Priority",?67,"Delinquent",!,XTBLINE,!
-	Q
-	;
-PAUSE	Q:IOST'?1"C-".E
-	K XTBANS,XTBOUT W !!,"Press ENTER to continue or '^' to end " R XTBANS:DTIME
-	I XTBANS[U!('$T) S (XTBNMSP,XTBPTNAM,XTBCPLDT,XTBDA)="99999999",XTBOUT=1
-	Q
+XTPMSTA2 ;OAK/BP - PRINT PATCH STATISTICS BY COMPLIANCE DATE; [1/4/06 9:33am]
+ ;;7.3;TOOLKIT;**98,100**; Apr 25, 1995;Build 4
+ ;
+ S IOP="HOME" D ^%ZIS K IOP
+EN W @IOF,"Patch Monitor Statistics By Compliance Date",!!!
+ ;
+DATE W ! S %DT="AEP"
+ S %DT("A")="Enter BEGINNING Compliance date: " D ^%DT G:Y<0 EXIT S XTBBDT=Y X ^DD("DD") S XTBBDT1=Y
+ S %DT="AE",%DT("A")="     and ENDING Compliance date: " D ^%DT G:Y<0 EXIT S XTBEDT=Y X ^DD("DD") S XTBEDT1=Y
+ I XTBEDT<XTBBDT W !!,$C(7),"Starting date is later than ending date.",!! H 2 G DATE
+ W !!,"Do you want to see the patch data" S %=2 D YN^DICN S XTBVIEW=%
+ ;
+DEV W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT
+ I $D(IO("Q")) S ZTIO=ION,ZTRTN="SORT^XTPMSTA2",ZTSAVE("XTB*")="",ZTDESC="Patch Monitor Statistics By Compliance Date" D ^%ZTLOAD D HOME^%ZIS
+ I $D(ZTSK) W !,"Queued as task #",ZTSK H 2 G EXIT
+ ;
+ ; sort patches by compliance date
+SORT U IO K ^TMP($J)
+ F XTBCPLDT=(XTBBDT-.0001):0 S XTBCPLDT=$O(^XPD(9.9,"D",XTBCPLDT)) Q:XTBCPLDT=""!(XTBCPLDT>XTBEDT)  DO
+ .F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"D",XTBCPLDT,XTBDA)) Q:XTBDA=""  DO
+ ..S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
+ ..S XTBPTNAM=$P(XTBDTA,U,1),XTBNMSP=$P($P(XTBDTA,U,4)," - ",1) Q:XTBNMSP=""  ;parent package missing in file
+ ..S XTBRELDT=$P(XTBDTA,U,2),XTBPRIOR=$P(XTBDTA,U,3)
+ ..S ^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)=XTBRELDT_U_XTBPRIOR
+PRINT ; 
+ S Y=DT X ^DD("DD") S XTBCURDT=Y
+ K XTBLINE S $P(XTBLINE,"-",(IOM-2))="-"
+ S PG=0 D HDR ; first header
+ S XTBPTNAM="",(XTBTPTCH,XTBTLATE)=0
+ 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)
+ .F XTBDA=0:0 S XTBDA=$O(^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)) Q:XTBDA=""  DO  Q:$D(XTBOUT)
+ ..S XTBTPTCH=XTBTPTCH+1
+ ..S XTBDTA=^TMP($J,XTBCPLDT,XTBPTNAM,XTBDA)
+ ..S XTBRELDT=$P(XTBDTA,U),XTBPRIOR=$P(XTBDTA,U,2)
+ ..S XTBRCVDT=$P($G(^XPD(9.9,XTBDA,0)),U,2)
+ ..S XTBPTYPE=$P($G(^XPD(9.9,XTBDA,0)),U,10)
+ ..I +XTBPTYPE=0 S D0=XTBDA D ^XTPMKPCF S XTBINSDT=X K D0
+ ..I +XTBPTYPE=1 S XTBINSDT=$P($G(^XPD(9.9,XTBDA,0)),U,11)
+ ..I XTBINSDT]"" S X1=XTBINSDT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
+ ..I XTBINSDT="" S X1=DT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
+ ..S Y=XTBINSDT X ^DD("DD") S XTBINSDT=Y
+ ..S Y=XTBCPLDT X ^DD("DD") S XTBCPLDX=Y
+ ..S Y=XTBRELDT X ^DD("DD") S XTBRELDT=Y
+ ..S XTBPRIOR=$S(XTBPRIOR="m":"Mandatory",XTBPRIOR="e":"Emergency",1:"Unknown")
+ ..I XTBVIEW=1 W XTBCPLDX,?14,XTBPTNAM,?27,XTBRELDT,?41,XTBINSDT,?55,XTBPRIOR
+ ..I XTBVIEW=1,XTBDAYLT>0 W ?67,$J(XTBDAYLT,3,0)_$S(XTBDAYLT>1:" days",1:" day")
+ ..I XTBDAYLT>0 S XTBTLATE=XTBTLATE+1
+ ..I XTBVIEW=1 W ! I $Y>(IOSL-6),IOST?1"C-".E D PAUSE Q:$D(XTBOUT)
+ ..I XTBVIEW=1 I $Y>(IOSL-6) D HDR
+ G:$D(XTBOUT) EXIT
+ I $Y>(IOSL-6),IOST?1"C-".E D HDR
+ W !!?6,"Totals patches received for date range: ",XTBTPTCH,!
+ W "Total patches installed past compliance date: ",XTBTLATE,!!
+ S XTBDIVOK=0 I XTBTPTCH>0 S XTBDIVOK=1
+ W ?25,"Delinquent patch % : ",$S(XTBDIVOK=1:$J((XTBTLATE/XTBTPTCH*100),6,2),1:100)_" %",!
+ W ?25,"      Compliance % : ",$S(XTBDIVOK=1:$J(100-(XTBTLATE/XTBTPTCH*100),6,2),1:100)," %",!
+ I IOST?1"C-".E K XTBANS W !!,"Press ENTER to end " R XTBANS:DTIME
+ ;
+EXIT I IOST?1"C-".E W @IOF,!
+ D ^%ZISC
+ K %,%DT,%ZIS,XTBNMSP,XTBANS,XTBBDT,XTBBDT1,XTBCPLDT,XTBCPLDX,XTBDA,XTBEDT,XTBEDT1,XTBDAYLT
+ K XTBINSDT,XTBLINE,XTBNMSP,XTBOLDNM,XTBNMSP,XTBPTNAM,XTBPTYPE,XTBDTA,XTBGPDA
+ K XTBRCVDT,XTBTLATE,XTBTPTCH,D0,DIC,PG,POP,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%T,%Y
+ K ^TMP($J),XTBOUT,XTBPGF,XTBOLGRP,ZTSK,XTBRELDT,XTBPRIOR,XTBCURDT,XTBDIVOK,XTBVIEW
+ Q
+ ;
+HDR S PG=PG+1 I IOST?1"P-".E,PG>1 W @IOF
+ I IOST?1"C-".E W @IOF
+ W XTBCURDT S X="Patch Statistical Report for "_^DD("SITE")
+ W ?(IOM-$L(X)\2),X,?(IOM-12),"Page: ",PG,!,?31,"By Compliance Date",!
+ S X="Date range: "_XTBBDT1_" to "_XTBEDT1 W ?(IOM-$L(X)\2),X,!
+ W !,"Compliance",?14,"Patch",?27,"Release",?41,"Install",?67,"# Days",!
+ W "Date",?14,"Number",?27,"Date",?41,"Date",?55,"Priority",?67,"Delinquent",!,XTBLINE,!
+ Q
+ ;
+PAUSE Q:IOST'?1"C-".E
+ K XTBANS,XTBOUT W !!,"Press ENTER to continue or '^' to end " R XTBANS:DTIME
+ I XTBANS[U!('$T) S (XTBNMSP,XTBPTNAM,XTBCPLDT,XTBDA)="99999999",XTBOUT=1
+ Q