BLRLABIR ; IHS/MSC/MKK - Lab Install Reports ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
EP ; EP
PEP ; EP
; New everything but Default variables
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D MAKEMENU
;
; Main Menu driver
D MENUDRVR^BLRGMENU("IHS Laboratory User Support","Lab Patch Install Reports")
Q
;
S BLRVERN=$P($P($T(+1),";")," ")
;
D ADDTMENU^BLRGMENU("IHSONLY^BLRLABIR","IHS Lab Patches Only")
D ADDTMENU^BLRGMENU("VAONLY^BLRLABIR","VA Lab Patches Only")
D ADDTMENU^BLRGMENU("BOTH^BLRLABIR","IHS & VA Lab Patches")
Q
;
IHSONLY ; EP - IHS Lab Patches Only Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$INITVARS("IHS Lab Package Patch Installs")="Q"
;
F SEED="BLR*5.2*1099","LR*5.2*1099" D
. S SEEDBEG=$P(SEED,"*")
. S SEEDBEGL=$L(SEEDBEG)
. S PATCH=SEED
. F S PATCH=$O(^XPD(9.7,"B",PATCH),-1) Q:PATCH=""!($E(PATCH,1,SEEDBEGL)'=SEEDBEG)!(QFLG="Q") D
.. S IEN="A"
.. F S IEN=$O(^XPD(9.7,"B",PATCH,IEN),-1) Q:IEN<1!(QFLG="Q") D
... D LINEDATA
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU(9)
Q
;
VAONLY ; EP - VA Lab Patches Only Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$INITVARS("VA Lab Package Patch Installs")="Q"
;
F S PATCH=$O(^XPD(9.7,"B",PATCH),-1) Q:PATCH=""!($E(PATCH,1,2)'="LR")!($L($P(PATCH,"*",3))>3)!(QFLG="Q") D
. S IEN="A"
. F S IEN=$O(^XPD(9.7,"B",PATCH,IEN),-1) Q:IEN<1!(QFLG="Q") D
.. D LINEDATA
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU(9)
Q
;
BOTH ; EP - Both VA and RPMS Lab Patches Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D BOTHCOMP
;
Q:$$INITVARS("RPMS Lab Package Patch Installs")="Q"
;
S WHNSTART=.9999999
F S WHNSTART=$O(^TMP("BLRLABIR",$J,WHNSTART)) Q:WHNSTART<1!(QFLG="Q") D
. S PATCH=""
. F S PATCH=$O(^TMP("BLRLABIR",$J,WHNSTART,PATCH)) Q:PATCH=""!(QFLG="Q") D
.. S IEN=.9999999
.. F S IEN=$O(^TMP("BLRLABIR",$J,WHNSTART,PATCH,IEN)) Q:IEN<1!(QFLG="Q") D
... D LINEDATA
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU(9)
;
Q
;
BOTHCOMP ; EP - Compile Data for Combined Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S BLRVERN=$P($P($T(+1),";")," ")
S HEADER(1)="RPMS Lab Package Patch Installs"
S HEADER(2)="Compilation of Data"
;
D HEADERDT^BLRGMENU
;
K ^TMP("BLRLABIR")
;
W ?5,"Compiling"
S PATCH="LR*5.2*A"
;
F SEED="BLR*5.2*1099","LR*5.2*A" D
. S SEEDBEG=$P(SEED,"*")
. S SEEDBEGL=$L(SEEDBEG)
. S PATCH=SEED
. F S PATCH=$O(^XPD(9.7,"B",PATCH),-1) Q:PATCH=""!($E(PATCH,1,SEEDBEGL)'=SEEDBEG) D
.. S IEN="A"
.. F S IEN=$O(^XPD(9.7,"B",PATCH,IEN),-1) Q:IEN<1 D
... W "." W:$X>74 !,?5
... ;
... S STARTDTT=$P($G(^XPD(9.7,IEN,1)),"^")
... S ^TMP("BLRLABIR",$J,STARTDTT,PATCH,IEN)=""
;
W !!,?5,"Compilation Complete."
D PRESSKEY^BLRGMENU(10)
Q
;
INITVARS(HEADL1) ; EP - Initialization of variables
S BLRVERN=$P($P($T(+1),";")," ")
;
S HEADER(1)=HEADL1
S HEADER(2)="Reverse Patch Sort"
S HEADER(3)=" "
S HEADER(4)="Patch #"
S $E(HEADER(4),14)="Package Name"
S $E(HEADER(4),29)="Started Date/Time"
S $E(HEADER(4),51)="Completed Date/Time"
S $E(HEADER(4),73)="File 200"
;
S:HEADL1["IHS" PATCH="LR*5.2*1099"
S:HEADL1["VA" PATCH="LR*5.2*A"
S:HEADL1["RPMS" HEADER(2)="Start Date/Time Sort"
;
D ^%ZIS
I POP D Q "Q"
. W !,?4,"Could not open output Device. Routine Ends.",!
. D PRESSKEY^BLRGMENU(9)
;
S QFLG="NO"
S MAXLINES=$S(IOT["VT":(IOSL-4),1:IOSL)
S LINES=MAXLINES+10,PG=0
;
U IO
;
Q "OK"
;
LINEDATA ; EP - Write a line of Data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO") I QFLG="Q" Q
;
D INSTLLFB
;
W $E(PATCH,1,12)
W ?13,$E(NAME,1,13)
W ?28,STARTDTT
W ?50,COMPDTT
W ?72,WHOINSTALL
W !
S LINES=LINES+1
Q
;
INSTLLFB ; EP - INSTALL File Breakout of Variables
S STR=$G(^XPD(9.7,IEN,0))
S WHOINSTALL=$P(STR,"^",11)
;
S PKGFLINK=$P(STR,"^",2)
S NAME=$P($G(^DIC(9.4,+PKGFLINK,0)),"^")
;
S STR=$G(^XPD(9.7,IEN,1))
;
S STARTDTT=$P(STR,"^")
S:$L(STARTDTT) STARTDTT=$$FMTE^XLFDT(STARTDTT,"5Z")
;
S COMPDTT=$P(STR,"^",3)
S:$L(COMPDTT) COMPDTT=$$FMTE^XLFDT(COMPDTT,"5Z")
Q
BLRLABIR ; IHS/MSC/MKK - Lab Install Reports ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
EP ; EP
PEP ; EP
+1 ; New everything but Default variables
+2 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+3 ;
+4 DO MAKEMENU
+5 ;
+6 ; Main Menu driver
+7 DO MENUDRVR^BLRGMENU("IHS Laboratory User Support","Lab Patch Install Reports")
+8 QUIT
+9 ;
+1 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+2 ;
+3 DO ADDTMENU^BLRGMENU("IHSONLY^BLRLABIR","IHS Lab Patches Only")
+4 DO ADDTMENU^BLRGMENU("VAONLY^BLRLABIR","VA Lab Patches Only")
+5 DO ADDTMENU^BLRGMENU("BOTH^BLRLABIR","IHS & VA Lab Patches")
+6 QUIT
+7 ;
IHSONLY ; EP - IHS Lab Patches Only Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$INITVARS("IHS Lab Package Patch Installs")="Q"
QUIT
+4 ;
+5 FOR SEED="BLR*5.2*1099","LR*5.2*1099"
Begin DoDot:1
+6 SET SEEDBEG=$PIECE(SEED,"*")
+7 SET SEEDBEGL=$LENGTH(SEEDBEG)
+8 SET PATCH=SEED
+9 FOR
SET PATCH=$ORDER(^XPD(9.7,"B",PATCH),-1)
IF PATCH=""!($EXTRACT(PATCH,1,SEEDBEGL)'=SEEDBEG)!(QFLG="Q")
QUIT
Begin DoDot:2
+10 SET IEN="A"
+11 FOR
SET IEN=$ORDER(^XPD(9.7,"B",PATCH,IEN),-1)
IF IEN<1!(QFLG="Q")
QUIT
Begin DoDot:3
+12 DO LINEDATA
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 DO ^%ZISC
+15 ;
+16 DO PRESSKEY^BLRGMENU(9)
+17 QUIT
+18 ;
VAONLY ; EP - VA Lab Patches Only Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$INITVARS("VA Lab Package Patch Installs")="Q"
QUIT
+4 ;
+5 FOR
SET PATCH=$ORDER(^XPD(9.7,"B",PATCH),-1)
IF PATCH=""!($EXTRACT(PATCH,1,2)'="LR")!($LENGTH($PIECE(PATCH,"*",3))>3)!(QFLG="Q")
QUIT
Begin DoDot:1
+6 SET IEN="A"
+7 FOR
SET IEN=$ORDER(^XPD(9.7,"B",PATCH,IEN),-1)
IF IEN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+8 DO LINEDATA
End DoDot:2
End DoDot:1
+9 ;
+10 DO ^%ZISC
+11 ;
+12 DO PRESSKEY^BLRGMENU(9)
+13 QUIT
+14 ;
BOTH ; EP - Both VA and RPMS Lab Patches Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO BOTHCOMP
+4 ;
+5 IF $$INITVARS("RPMS Lab Package Patch Installs")="Q"
QUIT
+6 ;
+7 SET WHNSTART=.9999999
+8 FOR
SET WHNSTART=$ORDER(^TMP("BLRLABIR",$JOB,WHNSTART))
IF WHNSTART<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 SET PATCH=""
+10 FOR
SET PATCH=$ORDER(^TMP("BLRLABIR",$JOB,WHNSTART,PATCH))
IF PATCH=""!(QFLG="Q")
QUIT
Begin DoDot:2
+11 SET IEN=.9999999
+12 FOR
SET IEN=$ORDER(^TMP("BLRLABIR",$JOB,WHNSTART,PATCH,IEN))
IF IEN<1!(QFLG="Q")
QUIT
Begin DoDot:3
+13 DO LINEDATA
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 DO ^%ZISC
+16 ;
+17 DO PRESSKEY^BLRGMENU(9)
+18 ;
+19 QUIT
+20 ;
BOTHCOMP ; EP - Compile Data for Combined Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+4 SET HEADER(1)="RPMS Lab Package Patch Installs"
+5 SET HEADER(2)="Compilation of Data"
+6 ;
+7 DO HEADERDT^BLRGMENU
+8 ;
+9 KILL ^TMP("BLRLABIR")
+10 ;
+11 WRITE ?5,"Compiling"
+12 SET PATCH="LR*5.2*A"
+13 ;
+14 FOR SEED="BLR*5.2*1099","LR*5.2*A"
Begin DoDot:1
+15 SET SEEDBEG=$PIECE(SEED,"*")
+16 SET SEEDBEGL=$LENGTH(SEEDBEG)
+17 SET PATCH=SEED
+18 FOR
SET PATCH=$ORDER(^XPD(9.7,"B",PATCH),-1)
IF PATCH=""!($EXTRACT(PATCH,1,SEEDBEGL)'=SEEDBEG)
QUIT
Begin DoDot:2
+19 SET IEN="A"
+20 FOR
SET IEN=$ORDER(^XPD(9.7,"B",PATCH,IEN),-1)
IF IEN<1
QUIT
Begin DoDot:3
+21 WRITE "."
IF $X>74
WRITE !,?5
+22 ;
+23 SET STARTDTT=$PIECE($GET(^XPD(9.7,IEN,1)),"^")
+24 SET ^TMP("BLRLABIR",$JOB,STARTDTT,PATCH,IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 WRITE !!,?5,"Compilation Complete."
+27 DO PRESSKEY^BLRGMENU(10)
+28 QUIT
+29 ;
INITVARS(HEADL1) ; EP - Initialization of variables
+1 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+2 ;
+3 SET HEADER(1)=HEADL1
+4 SET HEADER(2)="Reverse Patch Sort"
+5 SET HEADER(3)=" "
+6 SET HEADER(4)="Patch #"
+7 SET $EXTRACT(HEADER(4),14)="Package Name"
+8 SET $EXTRACT(HEADER(4),29)="Started Date/Time"
+9 SET $EXTRACT(HEADER(4),51)="Completed Date/Time"
+10 SET $EXTRACT(HEADER(4),73)="File 200"
+11 ;
+12 IF HEADL1["IHS"
SET PATCH="LR*5.2*1099"
+13 IF HEADL1["VA"
SET PATCH="LR*5.2*A"
+14 IF HEADL1["RPMS"
SET HEADER(2)="Start Date/Time Sort"
+15 ;
+16 DO ^%ZIS
+17 IF POP
Begin DoDot:1
+18 WRITE !,?4,"Could not open output Device. Routine Ends.",!
+19 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT "Q"
+20 ;
+21 SET QFLG="NO"
+22 SET MAXLINES=$SELECT(IOT["VT":(IOSL-4),1:IOSL)
+23 SET LINES=MAXLINES+10
SET PG=0
+24 ;
+25 USE IO
+26 ;
+27 QUIT "OK"
+28 ;
LINEDATA ; EP - Write a line of Data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,"NO")
IF QFLG="Q"
QUIT
+2 ;
+3 DO INSTLLFB
+4 ;
+5 WRITE $EXTRACT(PATCH,1,12)
+6 WRITE ?13,$EXTRACT(NAME,1,13)
+7 WRITE ?28,STARTDTT
+8 WRITE ?50,COMPDTT
+9 WRITE ?72,WHOINSTALL
+10 WRITE !
+11 SET LINES=LINES+1
+12 QUIT
+13 ;
INSTLLFB ; EP - INSTALL File Breakout of Variables
+1 SET STR=$GET(^XPD(9.7,IEN,0))
+2 SET WHOINSTALL=$PIECE(STR,"^",11)
+3 ;
+4 SET PKGFLINK=$PIECE(STR,"^",2)
+5 SET NAME=$PIECE($GET(^DIC(9.4,+PKGFLINK,0)),"^")
+6 ;
+7 SET STR=$GET(^XPD(9.7,IEN,1))
+8 ;
+9 SET STARTDTT=$PIECE(STR,"^")
+10 IF $LENGTH(STARTDTT)
SET STARTDTT=$$FMTE^XLFDT(STARTDTT,"5Z")
+11 ;
+12 SET COMPDTT=$PIECE(STR,"^",3)
+13 IF $LENGTH(COMPDTT)
SET COMPDTT=$$FMTE^XLFDT(COMPDTT,"5Z")
+14 QUIT
