- FSCRPCGJ ;SLC/STAFF-NOIS RPC Patch Report Summary ;1/13/98 15:46
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- PATCH(PATCH) ; from FSCRPCG
- N CNT,LINE,NUM,PACKZERO,ZERO
- S CNT=0
- S ZERO=$G(^A1AE(11005,+$G(PATCH),0)) I '$L(ZERO) Q
- 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("================================================================================",.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,+$G(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[HFSCRPCGJ 4590 printed Feb 18, 2025@23:45:51 Page 2
- FSCRPCGJ ;SLC/STAFF-NOIS RPC Patch Report Summary ;1/13/98 15:46
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- PATCH(PATCH) ; from FSCRPCG
- +1 NEW CNT,LINE,NUM,PACKZERO,ZERO
- +2 SET CNT=0
- +3 SET ZERO=$GET(^A1AE(11005,+$GET(PATCH),0))
- IF '$LENGTH(ZERO)
- QUIT
- +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("================================================================================",.CNT)
- +42 SET LINE="User Information:"
- +43 DO SET(LINE,.CNT)
- +44 SET LINE="Entered By : "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,9),0)),U)
- +45 SET LINE=$$SETSTR^VALM1(" Date Entered : ",LINE,50,16)
- +46 IF $PIECE(ZERO,U,12)
- SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,12))
- +47 DO SET(LINE,.CNT)
- +48 SET LINE="Completed By: "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,13),0)),U)
- +49 SET LINE=$$SETSTR^VALM1("Date Completed: ",LINE,50,16)
- +50 IF $PIECE(ZERO,U,10)
- SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,10))
- +51 DO SET(LINE,.CNT)
- +52 SET LINE="Released By : "_$PIECE($GET(^VA(200,+$PIECE(ZERO,U,14),0)),U)
- +53 SET LINE=$$SETSTR^VALM1(" Date Released: ",LINE,50,16)
- +54 IF $PIECE(ZERO,U,11)
- SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,U,11))
- +55 DO SET(LINE,.CNT)
- +56 DO SET("================================================================================",.CNT)
- +57 QUIT
- +58 ;
- ASSOC(PATCH,CNT) ;
- +1 IF '$DATA(^A1AE(11005,+$GET(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