- DIFROM7 ;SFISC/(SLC/STAFF)-SITE TRACKING INSTALL BULLETIN ;29NOV2012
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- SETUP(ROUTINE,STATUS) ;
- K ^TMP($J) N LINE,LINE1,LINE2,NUM,OK,ROUTINIS,TXT
- D:'$D(DISYS) OS^DII
- D LOAD(ROUTINE,"^TMP($J,",0)
- I $P($P(^TMP($J,1,0),";")," ")'?1U1.3UN1"INIT" S STATUS="not changed" Q
- S ROUTINIS=$P(ROUTINE,"INIT")_"INIS"
- S (OK,LINE)=0 F S LINE=$O(^TMP($J,LINE)) Q:LINE<0 S TXT=^(LINE,0) S:TXT[("PAC^"_ROUTINIS) OK=2 Q:OK=2 I TXT["=DIFROM G Q^DIFROM" S OK=1 Q
- I 'OK S STATUS="not installed" Q
- I OK=1 D
- .S ^TMP($J,LINE-.9,0)=" I DIFROM,$D(^%ZTSK) S X="""_ROUTINIS_""" X ^%ZOSF(""TEST"") D:$T PAC^"_ROUTINIS_"($T(IXF),.DIFROM)"
- .D SAVE(ROUTINE,"^TMP($J,",0)
- .S STATUS="site tracking installed"
- I OK=2 S STATUS="already installed"
- S LINE1=ROUTINIS_$P(^TMP($J,1,0),ROUTINE,2,99),LINE2=^TMP($J,2,0) K ^TMP($J)
- S ^TMP($J,1,0)=LINE1,^TMP($J,2,0)=LINE2
- F NUM=3:1 S LINE=$P($T(NMSPINIS+NUM),";",3,99) Q:LINE="" D
- .I LINE["@@@@@@" S LINE=$P(LINE,"@@@@@@")_ROUTINIS_$P(LINE,"@@@@@@",2)
- .S ^TMP($J,NUM,0)=LINE
- D SAVE(ROUTINIS,"^TMP($J,",0)
- S STATUS=STATUS_" -- "_ROUTINIS_" saved"
- K ^TMP($J)
- Q
- LOAD(X,DIF,XCNP) X ^DD("OS",DISYS,"LOAD")
- Q
- SAVE(X,DIE,XCN) ; VEN/SMH - Modified save code to work on Standalone Fileman
- K ^UTILITY($J,0)
- N I S I=0 F S I=$O(^TMP($J,I)) Q:'I S ^UTILITY($J,0,I)=^TMP($J,I,0)
- X ^DD("OS",DISYS,"ZS")
- K ^UTILITY($J,0)
- Q
- NMSPINIS ;;
- ;;
- ;;
- ;;PAC(PKG,VER) ; called from package init (DIFROM7 created this routine)
- ;; ; PKG = $T(IXF) of the INIT routine.
- ;; ; VER is an array that is contained in DIFROM from the INIT routine
- ;; ;
- ;; N %,%I,%H,DATE,DIFROM,NOW,PACKAGE,RUN,SERVER,SITE,START,X,XMDUZ,XMSUB,XMTEXT,XMY,Y K ^TMP("@@@@@@",$J)
- ;; ;
- ;; ; Site tracking updates only occur if run in a VA production primary domain
- ;; ; account.
- ;; I $G(^XMB("NETNAME"))'[".DOMAIN.EXT" Q
- ;; Q:'$D(^%ZOSF("UCI")) Q:'$D(^%ZOSF("PROD"))
- ;; X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") Q
- ;; ;
- ;; S SERVER="S.A5CSTS@DOMAIN.EXT"
- ;; S PACKAGE=$P($P(PKG,";",3),U)
- ;; S SITE=$G(^XMB("NETNAME"))
- ;; S START=$P($G(^DIC(9.4,VER(0),"PRE")),U,2) I '$L(START) S START="Unknown"
- ;; D ; check if ok to use kernel functions
- ;; .S X="XLFDT" X ^%ZOSF("TEST") I $T D Q
- ;; ..S NOW=$$HTFM^XLFDT($H)
- ;; ..S RUN="Unknown" I START S RUN=$$FMDIFF^XLFDT(NOW,START,3)
- ;; ..S START=$$FMTE^XLFDT(START)
- ;; ..S DATE=NOW\1
- ;; ..S NOW=$$FMTE^XLFDT(NOW)
- ;; .D NOW^%DTC S NOW=%,DATE=X
- ;; .S RUN="" ; don't bother to compute
- ;; .S Y=START D DD^%DT S START=Y
- ;; .S Y=NOW D DD^%DT S NOW=Y
- ;; ;
- ;; ; Message for server
- ;; S ^TMP("@@@@@@",$J,1,0)="PACKAGE INSTALL"
- ;; S ^TMP("@@@@@@",$J,2,0)="SITE: "_SITE
- ;; S ^TMP("@@@@@@",$J,3,0)="PACKAGE: "_PACKAGE
- ;; S ^TMP("@@@@@@",$J,4,0)="VERSION: "_VER
- ;; S ^TMP("@@@@@@",$J,5,0)="Start time: "_START
- ;; S ^TMP("@@@@@@",$J,6,0)="Completion time: "_NOW
- ;; S ^TMP("@@@@@@",$J,7,0)="Run time: "_RUN
- ;; S ^TMP("@@@@@@",$J,8,0)="DATE: "_DATE
- ;; ;
- ;; ; Data is sent to server on FORUM - S.A5CSTS
- ;; S XMY(SERVER)="",XMDUZ=.5,XMTEXT="^TMP(""@@@@@@"",$J,",XMSUB=PACKAGE_" VERSION "_VER_" INSTALLATION"
- ;; D ^XMD
- ;; K ^TMP("@@@@@@",$J)
- ;; Q
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROM7 3472 printed Feb 19, 2025@00:14:23 Page 2
- DIFROM7 ;SFISC/(SLC/STAFF)-SITE TRACKING INSTALL BULLETIN ;29NOV2012
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- SETUP(ROUTINE,STATUS) ;
- +1 KILL ^TMP($JOB)
- NEW LINE,LINE1,LINE2,NUM,OK,ROUTINIS,TXT
- +2 if '$DATA(DISYS)
- DO OS^DII
- +3 DO LOAD(ROUTINE,"^TMP($J,",0)
- +4 IF $PIECE($PIECE(^TMP($JOB,1,0),";")," ")'?1U1.3UN1"INIT"
- SET STATUS="not changed"
- QUIT
- +5 SET ROUTINIS=$PIECE(ROUTINE,"INIT")_"INIS"
- +6 SET (OK,LINE)=0
- FOR
- SET LINE=$ORDER(^TMP($JOB,LINE))
- if LINE<0
- QUIT
- SET TXT=^(LINE,0)
- if TXT[("PAC^"_ROUTINIS)
- SET OK=2
- if OK=2
- QUIT
- IF TXT["=DIFROM G Q^DIFROM"
- SET OK=1
- QUIT
- +7 IF 'OK
- SET STATUS="not installed"
- QUIT
- +8 IF OK=1
- Begin DoDot:1
- +9 SET ^TMP($JOB,LINE-.9,0)=" I DIFROM,$D(^%ZTSK) S X="""_ROUTINIS_""" X ^%ZOSF(""TEST"") D:$T PAC^"_ROUTINIS_"($T(IXF),.DIFROM)"
- +10 DO SAVE(ROUTINE,"^TMP($J,",0)
- +11 SET STATUS="site tracking installed"
- End DoDot:1
- +12 IF OK=2
- SET STATUS="already installed"
- +13 SET LINE1=ROUTINIS_$PIECE(^TMP($JOB,1,0),ROUTINE,2,99)
- SET LINE2=^TMP($JOB,2,0)
- KILL ^TMP($JOB)
- +14 SET ^TMP($JOB,1,0)=LINE1
- SET ^TMP($JOB,2,0)=LINE2
- +15 FOR NUM=3:1
- SET LINE=$PIECE($TEXT(NMSPINIS+NUM),";",3,99)
- if LINE=""
- QUIT
- Begin DoDot:1
- +16 IF LINE["@@@@@@"
- SET LINE=$PIECE(LINE,"@@@@@@")_ROUTINIS_$PIECE(LINE,"@@@@@@",2)
- +17 SET ^TMP($JOB,NUM,0)=LINE
- End DoDot:1
- +18 DO SAVE(ROUTINIS,"^TMP($J,",0)
- +19 SET STATUS=STATUS_" -- "_ROUTINIS_" saved"
- +20 KILL ^TMP($JOB)
- +21 QUIT
- LOAD(X,DIF,XCNP) XECUTE ^DD("OS",DISYS,"LOAD")
- +1 QUIT
- SAVE(X,DIE,XCN) ; VEN/SMH - Modified save code to work on Standalone Fileman
- +1 KILL ^UTILITY($JOB,0)
- +2 NEW I
- SET I=0
- FOR
- SET I=$ORDER(^TMP($JOB,I))
- if 'I
- QUIT
- SET ^UTILITY($JOB,0,I)=^TMP($JOB,I,0)
- +3 XECUTE ^DD("OS",DISYS,"ZS")
- +4 KILL ^UTILITY($JOB,0)
- +5 QUIT
- NMSPINIS ;;
- +1 ;;
- +2 ;;
- +3 ;;PAC(PKG,VER) ; called from package init (DIFROM7 created this routine)
- +4 ;; ; PKG = $T(IXF) of the INIT routine.
- +5 ;; ; VER is an array that is contained in DIFROM from the INIT routine
- +6 ;; ;
- +7 ;; N %,%I,%H,DATE,DIFROM,NOW,PACKAGE,RUN,SERVER,SITE,START,X,XMDUZ,XMSUB,XMTEXT,XMY,Y K ^TMP("@@@@@@",$J)
- +8 ;; ;
- +9 ;; ; Site tracking updates only occur if run in a VA production primary domain
- +10 ;; ; account.
- +11 ;; I $G(^XMB("NETNAME"))'[".DOMAIN.EXT" Q
- +12 ;; Q:'$D(^%ZOSF("UCI")) Q:'$D(^%ZOSF("PROD"))
- +13 ;; X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") Q
- +14 ;; ;
- +15 ;; S SERVER="S.A5CSTS@DOMAIN.EXT"
- +16 ;; S PACKAGE=$P($P(PKG,";",3),U)
- +17 ;; S SITE=$G(^XMB("NETNAME"))
- +18 ;; S START=$P($G(^DIC(9.4,VER(0),"PRE")),U,2) I '$L(START) S START="Unknown"
- +19 ;; D ; check if ok to use kernel functions
- +20 ;; .S X="XLFDT" X ^%ZOSF("TEST") I $T D Q
- +21 ;; ..S NOW=$$HTFM^XLFDT($H)
- +22 ;; ..S RUN="Unknown" I START S RUN=$$FMDIFF^XLFDT(NOW,START,3)
- +23 ;; ..S START=$$FMTE^XLFDT(START)
- +24 ;; ..S DATE=NOW\1
- +25 ;; ..S NOW=$$FMTE^XLFDT(NOW)
- +26 ;; .D NOW^%DTC S NOW=%,DATE=X
- +27 ;; .S RUN="" ; don't bother to compute
- +28 ;; .S Y=START D DD^%DT S START=Y
- +29 ;; .S Y=NOW D DD^%DT S NOW=Y
- +30 ;; ;
- +31 ;; ; Message for server
- +32 ;; S ^TMP("@@@@@@",$J,1,0)="PACKAGE INSTALL"
- +33 ;; S ^TMP("@@@@@@",$J,2,0)="SITE: "_SITE
- +34 ;; S ^TMP("@@@@@@",$J,3,0)="PACKAGE: "_PACKAGE
- +35 ;; S ^TMP("@@@@@@",$J,4,0)="VERSION: "_VER
- +36 ;; S ^TMP("@@@@@@",$J,5,0)="Start time: "_START
- +37 ;; S ^TMP("@@@@@@",$J,6,0)="Completion time: "_NOW
- +38 ;; S ^TMP("@@@@@@",$J,7,0)="Run time: "_RUN
- +39 ;; S ^TMP("@@@@@@",$J,8,0)="DATE: "_DATE
- +40 ;; ;
- +41 ;; ; Data is sent to server on FORUM - S.A5CSTS
- +42 ;; S XMY(SERVER)="",XMDUZ=.5,XMTEXT="^TMP(""@@@@@@"",$J,",XMSUB=PACKAGE_" VERSION "_VER_" INSTALLATION"
- +43 ;; D ^XMD
- +44 ;; K ^TMP("@@@@@@",$J)
- +45 ;; Q
- +46 ;;