FSCRPCGP ;SLC/STAFF-NOIS Patch Report ;1/13/98 15:46
;;1.1;NOIS;;Sep 06, 1998
;
PATCH(PATCH) ; from FSCRPCG
N CNT,LINE,LINE1,NUM,NUM1,PACKZERO,ZERO
S CNT=0
S ZERO=$G(^A1AE(11005,PATCH,0))
I '$L(ZERO) Q
S PACKZERO=$G(^DIC(9.4,+$P(ZERO,U,2),0))
D SET("=============================================================================",.CNT)
S LINE="Run Date: "_$$FMTE^XLFDT(DT)
S LINE=$$SETSTR^VALM1("Designation: ",LINE,46,13)_$P(ZERO,U)
D SET(LINE,.CNT)
S LINE="Package : "_$P(PACKZERO,U,2)_" - "_$P(PACKZERO,U)
S LINE=$$SETSTR^VALM1(" Priority: ",LINE,46,13)_$$PRIORITY($P(ZERO,U,7))
D SET(LINE,.CNT)
S LINE="Version : "_$P(ZERO,U,3)
I $P(ZERO,U,6) S LINE=$$SETSTR^VALM1("SEQ #"_$P(ZERO,U,6),LINE,23,12)
S LINE=$$SETSTR^VALM1(" Status: ",LINE,46,13)_$$STATUS($P(ZERO,U,8))
D SET(LINE,.CNT)
D SET("=============================================================================",.CNT)
D SET("",.CNT)
D ASSOC(PATCH,.CNT)
D SET("",.CNT)
S LINE="Subject: "_$P(ZERO,U,5)
D SET(LINE,.CNT)
D SET("",.CNT)
I $P(ZERO,U,8)'="v" Q ; *** don't display unreleased patch
D SET("Category",.CNT)
S NUM=0 F S NUM=$O(^A1AE(11005,PATCH,"C",NUM)) Q:NUM<1 S LINE=^(NUM,0) D
.S LINE=$$CATEGORY(LINE,$P(ZERO,U,7))
.I LINE="e" D
..S LINE="Enhancement ("
..I $P(ZERO,U,7)="m" S LINE=LINE_"Mandatory)" Q
..I $P(ZERO,U,7)="n" S LINE=LINE_"Optional)" Q
..S LINE=LINE_")"
.D SET(" - "_LINE,.CNT)
D SET("",.CNT)
D SET("Description",.CNT)
D SET("===========",.CNT)
D SET("",.CNT)
S NUM=0 F S NUM=$O(^A1AE(11005,PATCH,"D",NUM)) Q:NUM<1 S LINE=" "_^(NUM,0) D
.D SET(LINE,.CNT)
D SET("",.CNT)
D SET("Routine Information",.CNT)
D SET("===================",.CNT)
S NUM=0 F S NUM=$O(^A1AE(11005,PATCH,"P",NUM)) Q:NUM<1 S LINE=" - "_^(NUM,0) D
.D SET("",.CNT)
.D SET("Routine Name:",.CNT)
.D SET(LINE,.CNT)
.D SET("",.CNT)
.S NUM1=0 F S NUM1=$O(^A1AE(11005,PATCH,"P",NUM,"D",NUM1)) Q:NUM1<1 S LINE1=^(NUM1,0) D
..D SET(LINE,.CNT)
.D SET("",.CNT)
.D SET("Routine Checksum:",.CNT)
.S NUM1=0 F S NUM1=$O(^A1AE(11005,PATCH,"P",NUM,"X",NUM1)) Q:NUM1<1 S LINE1=^(NUM1,0) D
..D SET(LINE,.CNT)
D SET("",.CNT)
D SET("================================================================================",.CNT)
S LINE="User Information:"
D SET(LINE,.CNT)
S LINE="Entered By : "_$P($G(^VA(200,+$P(ZERO,U,9),0)),U)
S LINE=$$SETSTR^VALM1(" Date Entered : ",LINE,50,16)
I $P(ZERO,U,12) S LINE=LINE_$$FMTE^XLFDT($P(ZERO,U,12))
D SET(LINE,.CNT)
S LINE="Completed By: "_$P($G(^VA(200,+$P(ZERO,U,13),0)),U)
S LINE=$$SETSTR^VALM1("Date Completed: ",LINE,50,16)
I $P(ZERO,U,10) S LINE=LINE_$$FMTE^XLFDT($P(ZERO,U,10))
D SET(LINE,.CNT)
S LINE="Released By : "_$P($G(^VA(200,+$P(ZERO,U,14),0)),U)
S LINE=$$SETSTR^VALM1(" Date Released: ",LINE,50,16)
I $P(ZERO,U,11) S LINE=LINE_$$FMTE^XLFDT($P(ZERO,U,11))
D SET(LINE,.CNT)
D SET("================================================================================",.CNT)
Q
;
ASSOC(PATCH,CNT) ;
I '$D(^A1AE(11005,PATCH,"Q","B")) Q
N AN,AZ,APATCH,AZERO,NUM K AZ
S NUM=0 F S NUM=$O(^A1AE(11005,PATCH,"Q",NUM)) Q:NUM<1 S AZERO=$G(^(NUM,0)) I $L(AZERO) D
.S APATCH=+AZERO
.S AZ(APATCH)=$S($D(^A1AE(11005,APATCH,0)):"("_$P(^(0),U,8)_")"_$P(^(0),U),1:"patch not available")
.I AZ(APATCH)["*999*" S AZ(APATCH)=$P(AZ(APATCH),"*999*")_"*DBA*"_$P(AZ(APATCH),"*999*",2,99)
.I $P(AZERO,U,2)="y" S AZ("STOP",APATCH)=AZ(APATCH),AZ(APATCH)=$E(AZ(APATCH)_" ",1,15)_"<<= must be installed BEFORE '"_$P(^A1AE(11005,PATCH,0),U)_"'"
.E S AZ(APATCH)=$E(AZ(APATCH)_" ",1,19)_"install with patch '"_$P(^A1AE(11005,PATCH,0),U)_"'"
I $D(AZ)'=11 Q
S AN=0
S AZ=0 F S AZ=$O(AZ(AZ)) Q:'AZ I AZ(AZ)'["<<" D PSET(.AN,.AZ,.CNT)
S AZ=0 F S AZ=$O(AZ(AZ)) Q:'AZ I AZ(AZ)["<<" D PSET(.AN,.AZ,.CNT)
K AZ
Q
;
PSET(AN,AZ,CNT) ;
S AN=AN+1
I AN=1 D SET("Associated patches: "_AZ(AZ),.CNT) Q
E D SET(" "_AZ(AZ),.CNT)
Q
;
SET(LINE,CNT) ;
S CNT=CNT+1
S ^TMP("FSCRPC",$J,"OUTPUT",PATCH,CNT)=LINE
Q
PRIORITY(PRI) ; $$(priortiy) -> external value
I PRI="p" Q "Patch for a Patch"
I PRI="n" Q "Not Urgent"
I PRI="m" Q "Mandatory"
I PRI="e" Q "EMERGENCY"
I PRI="i" Q "Informational"
Q ""
;
STATUS(STATUS) ; $$(status) -> external value
I STATUS="c" Q "Completed/NotReleased"
I STATUS="e" Q "Entered in Error"
I STATUS="u" Q "Under Development"
I STATUS="v" Q "Released"
I STATUS="r" Q "Retired"
Q ""
;
CATEGORY(CAT,PRI) ; $$(category, priority) -> external value
I CAT="d" Q "Data Dictonary"
I CAT="i" Q "Input Template"
I CAT="p" Q "Print Template"
I CAT="r" Q "Routine"
I CAT="s" Q "Sort Template"
I CAT="o" Q "Other"
I CAT="db" Q "Database"
I CAT="pp" Q "PATCH FOR A PATCH"
I CAT="inf" Q "Informational"
I CAT="e" Q "Enhancement ("_$S(PRI="m":"Mandatory",PRI="n":"Optional",1:"")_")"
I CAT="d" Q "Data Dictonary"
Q ""
;
TEST ;
N NUM,PATCH
S PATCH=5800
D PATCH(PATCH)
S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"OUTPUT",PATCH,NUM)) Q:NUM<1 W !,^(NUM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCGP 5103 printed Dec 13, 2024@02:19:27 Page 2
FSCRPCGP ;SLC/STAFF-NOIS Patch Report ;1/13/98 15:46
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
PATCH(PATCH) ; from FSCRPCG
+1 NEW CNT,LINE,LINE1,NUM,NUM1,PACKZERO,ZERO
+2 SET CNT=0
+3 SET ZERO=$GET(^A1AE(11005,PATCH,0))
+4 IF '$LENGTH(ZERO)
QUIT
+5 SET PACKZERO=$GET(^DIC(9.4,+$PIECE(ZERO,U,2),0))
+6 DO SET("=============================================================================",.CNT)
+7 SET LINE="Run Date: "_$$FMTE^XLFDT(DT)
+8 SET LINE=$$SETSTR^VALM1("Designation: ",LINE,46,13)_$PIECE(ZERO,U)
+9 DO SET(LINE,.CNT)
+10 SET LINE="Package : "_$PIECE(PACKZERO,U,2)_" - "_$PIECE(PACKZERO,U)
+11 SET LINE=$$SETSTR^VALM1(" Priority: ",LINE,46,13)_$$PRIORITY($PIECE(ZERO,U,7))
+12 DO SET(LINE,.CNT)
+13 SET LINE="Version : "_$PIECE(ZERO,U,3)
+14 IF $PIECE(ZERO,U,6)
SET LINE=$$SETSTR^VALM1("SEQ #"_$PIECE(ZERO,U,6),LINE,23,12)
+15 SET LINE=$$SETSTR^VALM1(" Status: ",LINE,46,13)_$$STATUS($PIECE(ZERO,U,8))
+16 DO SET(LINE,.CNT)
+17 DO SET("=============================================================================",.CNT)
+18 DO SET("",.CNT)
+19 DO ASSOC(PATCH,.CNT)
+20 DO SET("",.CNT)
+21 SET LINE="Subject: "_$PIECE(ZERO,U,5)
+22 DO SET(LINE,.CNT)
+23 DO SET("",.CNT)
+24 ; *** don't display unreleased patch
IF $PIECE(ZERO,U,8)'="v"
QUIT
+25 DO SET("Category",.CNT)
+26 SET NUM=0
FOR
SET NUM=$ORDER(^A1AE(11005,PATCH,"C",NUM))
if NUM<1
QUIT
SET LINE=^(NUM,0)
Begin DoDot:1
+27 SET LINE=$$CATEGORY(LINE,$PIECE(ZERO,U,7))
+28 IF LINE="e"
Begin DoDot:2
+29 SET LINE="Enhancement ("
+30 IF $PIECE(ZERO,U,7)="m"
SET LINE=LINE_"Mandatory)"
QUIT
+31 IF $PIECE(ZERO,U,7)="n"
SET LINE=LINE_"Optional)"
QUIT
+32 SET LINE=LINE_")"
End DoDot:2
+33 DO SET(" - "_LINE,.CNT)
End DoDot:1
+34 DO SET("",.CNT)
+35 DO SET("Description",.CNT)
+36 DO SET("===========",.CNT)
+37 DO SET("",.CNT)
+38 SET NUM=0
FOR
SET NUM=$ORDER(^A1AE(11005,PATCH,"D",NUM))
if NUM<1
QUIT
SET LINE=" "_^(NUM,0)
Begin DoDot:1
+39 DO SET(LINE,.CNT)
End DoDot:1
+40 DO SET("",.CNT)
+41 DO SET("Routine Information",.CNT)
+42 DO SET("===================",.CNT)
+43 SET NUM=0
FOR
SET NUM=$ORDER(^A1AE(11005,PATCH,"P",NUM))
if NUM<1
QUIT
SET LINE=" - "_^(NUM,0)
Begin DoDot:1
+44 DO SET("",.CNT)
+45 DO SET("Routine Name:",.CNT)
+46 DO SET(LINE,.CNT)
+47 DO SET("",.CNT)
+48 SET NUM1=0
FOR
SET NUM1=$ORDER(^A1AE(11005,PATCH,"P",NUM,"D",NUM1))
if NUM1<1
QUIT
SET LINE1=^(NUM1,0)
Begin DoDot:2
+49 DO SET(LINE,.CNT)
End DoDot:2
+50 DO SET("",.CNT)
+51 DO SET("Routine Checksum:",.CNT)
+52 SET NUM1=0
FOR
SET NUM1=$ORDER(^A1AE(11005,PATCH,"P",NUM,"X",NUM1))
if NUM1<1
QUIT
SET LINE1=^(NUM1,0)
Begin DoDot:2
+53 DO SET(LINE,.CNT)
End DoDot:2
End DoDot:1
+54 DO SET("",.CNT)
+55 DO SET("================================================================================",.CNT)
+56 SET LINE="User Information:"
+57 DO SET(LINE,.CNT)
+58 SET LINE="Entered By : "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,9),0)),U)
+59 SET LINE=$$SETSTR^VALM1(" Date Entered : ",LINE,50,16)
+60 IF $PIECE(ZERO,U,12)
SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,12))
+61 DO SET(LINE,.CNT)
+62 SET LINE="Completed By: "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,13),0)),U)
+63 SET LINE=$$SETSTR^VALM1("Date Completed: ",LINE,50,16)
+64 IF $PIECE(ZERO,U,10)
SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,10))
+65 DO SET(LINE,.CNT)
+66 SET LINE="Released By : "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,14),0)),U)
+67 SET LINE=$$SETSTR^VALM1(" Date Released: ",LINE,50,16)
+68 IF $PIECE(ZERO,U,11)
SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,11))
+69 DO SET(LINE,.CNT)
+70 DO SET("================================================================================",.CNT)
+71 QUIT
+72 ;
ASSOC(PATCH,CNT) ;
+1 IF '$DATA(^A1AE(11005,PATCH,"Q","B"))
QUIT
+2 NEW AN,AZ,APATCH,AZERO,NUM
KILL AZ
+3 SET NUM=0
FOR
SET NUM=$ORDER(^A1AE(11005,PATCH,"Q",NUM))
if NUM<1
QUIT
SET AZERO=$GET(^(NUM,0))
IF $LENGTH(AZERO)
Begin DoDot:1
+4 SET APATCH=+AZERO
+5 SET AZ(APATCH)=$SELECT($DATA(^A1AE(11005,APATCH,0)):"("_$PIECE(^(0),U,8)_")"_$PIECE(^(0),U),1:"patch not available")
+6 IF AZ(APATCH)["*999*"
SET AZ(APATCH)=$PIECE(AZ(APATCH),"*999*")_"*DBA*"_$PIECE(AZ(APATCH),"*999*",2,99)
+7 IF $PIECE(AZERO,U,2)="y"
SET AZ("STOP",APATCH)=AZ(APATCH)
SET AZ(APATCH)=$EXTRACT(AZ(APATCH)_" ",1,15)_"<<= must be installed BEFORE '"_$PIECE(^A1AE(11005,PATCH,0),U)_"'"
+8 IF '$TEST
SET AZ(APATCH)=$EXTRACT(AZ(APATCH)_" ",1,19)_"install with patch '"_$PIECE(^A1AE(11005,PATCH,0),U)_"'"
End DoDot:1
+9 IF $DATA(AZ)'=11
QUIT
+10 SET AN=0
+11 SET AZ=0
FOR
SET AZ=$ORDER(AZ(AZ))
if 'AZ
QUIT
IF AZ(AZ)'["<<"
DO PSET(.AN,.AZ,.CNT)
+12 SET AZ=0
FOR
SET AZ=$ORDER(AZ(AZ))
if 'AZ
QUIT
IF AZ(AZ)["<<"
DO PSET(.AN,.AZ,.CNT)
+13 KILL AZ
+14 QUIT
+15 ;
PSET(AN,AZ,CNT) ;
+1 SET AN=AN+1
+2 IF AN=1
DO SET("Associated patches: "_AZ(AZ),.CNT)
QUIT
+3 IF '$TEST
DO SET(" "_AZ(AZ),.CNT)
+4 QUIT
+5 ;
SET(LINE,CNT) ;
+1 SET CNT=CNT+1
+2 SET ^TMP("FSCRPC",$JOB,"OUTPUT",PATCH,CNT)=LINE
+3 QUIT
PRIORITY(PRI) ; $$(priortiy) -> external value
+1 IF PRI="p"
QUIT "Patch for a Patch"
+2 IF PRI="n"
QUIT "Not Urgent"
+3 IF PRI="m"
QUIT "Mandatory"
+4 IF PRI="e"
QUIT "EMERGENCY"
+5 IF PRI="i"
QUIT "Informational"
+6 QUIT ""
+7 ;
STATUS(STATUS) ; $$(status) -> external value
+1 IF STATUS="c"
QUIT "Completed/NotReleased"
+2 IF STATUS="e"
QUIT "Entered in Error"
+3 IF STATUS="u"
QUIT "Under Development"
+4 IF STATUS="v"
QUIT "Released"
+5 IF STATUS="r"
QUIT "Retired"
+6 QUIT ""
+7 ;
CATEGORY(CAT,PRI) ; $$(category, priority) -> external value
+1 IF CAT="d"
QUIT "Data Dictonary"
+2 IF CAT="i"
QUIT "Input Template"
+3 IF CAT="p"
QUIT "Print Template"
+4 IF CAT="r"
QUIT "Routine"
+5 IF CAT="s"
QUIT "Sort Template"
+6 IF CAT="o"
QUIT "Other"
+7 IF CAT="db"
QUIT "Database"
+8 IF CAT="pp"
QUIT "PATCH FOR A PATCH"
+9 IF CAT="inf"
QUIT "Informational"
+10 IF CAT="e"
QUIT "Enhancement ("_$SELECT(PRI="m":"Mandatory",PRI="n":"Optional",1:"")_")"
+11 IF CAT="d"
QUIT "Data Dictonary"
+12 QUIT ""
+13 ;
TEST ;
+1 NEW NUM,PATCH
+2 SET PATCH=5800
+3 DO PATCH(PATCH)
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"OUTPUT",PATCH,NUM))
if NUM<1
QUIT
WRITE !,^(NUM)
+5 QUIT
