- VBECSRV ;DALLAS CIOFO/RLM - INTEGRITY CHECKER FOR BLOOD BANK ROUTINES ;08/20/2001 4:35 PM
- ;;2.0;VBEC;**8**;Jun 05, 2015;Build 27
- ;
- START ;
- K ^TMP($J,"VBECDATA")
- S VBECSITE=$P($$SITE^VASITE,U,2),VBECSIT1=$P($$SITE^VASITE,U,1)
- ;Determine station number
- S VBECSUB=$TR(XQSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;Translate the subject into upper case and place it into a locally
- ;namespaced variable.
- S ^TMP("VBECINTEG",$J,1,0)=VBECSUB_" triggered at "_VBECSITE_" by "_XMFROM_" on "_XQDATE
- ;The first line of the message tells who requested the action and when.
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- I VBECSUB["REPORT" D REPORT G EXIT
- I VBECSUB["UPDATE" D UPDATE G EXIT
- I VBECSUB["LIST" D LIST G EXIT
- I VBECSUB["PATCH" D PATCH G EXIT
- K XMTEXT,XMSUB,VBECSITE,VBECNOW,XMY
- ;Call a routine based on the "Subject" line of the message.
- ;Skip the rest of the routine (down to exit) if the subject
- ;is a valid call.
- S VBECSITE=$P($$SITE^VASITE,U,2),VBECSIT1=$P($$SITE^VASITE,U,1)
- S ^TMP($J,"VBECDATA",1)=""
- S ^TMP($J,"VBECDATA",2)="Sorry, but I don't know how to "_XQSUB
- S ^TMP($J,"VBECDATA",3)="No action taken"
- S ^TMP($J,"VBECDATA",3)="Invalid VBEC Server Request From "_XMFROM_" at "_VBECSITE_" run on "_VBECNOW
- S XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- S XMSUB="Invalid BB Server Request From "_XMFROM_" at "_VBECSITE_" run on "_VBECNOW
- S XMTEXT="^TMP($J,""VBECDATA"",",XMDUZ="Blood Bank Monitor"
- D ^XMD
- ;Send a message to the designated mail group if the server is triggered with
- ;an invalid command. This lets the users know that they either made
- ;a typo, or that someone is attempting to improperly invoke the server.
- EXIT K %DT,XMTEXT,XMSUB,VBECSITE,VBECNOW,XMY,^TMP($J,"VBECDATA")
- Q
- REPORT ;report on invalid checksums at a site.
- S VBECSITE=$P($$SITE^VASITE,U,2),VBECSIT1=$P($$SITE^VASITE,U,1)
- S X=$T(+0) X ^%ZOSF("RSUM1") S ^TMP("VBECINTEG",$J,2,0)="VBECSRV at "_VBECSITE_" = "_Y,^TMP("VBECINTEG1",$J,3,0)="**VBECSRV^"_Y_"^^"_VBECSIT1_"^"_DT
- S VBA=0,VBI=4 F S VBA=$O(^VBEC(6002.04,VBA)) Q:'VBA S VBDATA=$G(^VBEC(6002.04,VBA,0)) D
- . S X=$P(VBDATA,"^") X ^%ZOSF("TEST") I '$T S ^TMP("VBECINTEG",$J,VBI,0)=X_" is missing.",VBI=VBI+1,^TMP("VBECINTEG1",$J,VBI,0)="**"_X_"^"_$P(VBDATA,"^",2)_"^0^"_DT,VBI=VBI+1 Q
- . X ^%ZOSF("RSUM1") I $P(VBDATA,"^",2)'=Y S ^TMP("VBECINTEG",$J,VBI,0)=X_" should be "_$P(VBDATA,"^",2)_" is "_Y,VBI=VBI+1
- . S ^TMP("VBECINTEG1",$J,VBI,0)="**"_X_"^"_$P(VBDATA,"^",2)_"^"_Y_"^"_VBECSIT1_"^"_DT_"^"_(Y'=$P(VBDATA,"^",2)),VBI=VBI+1
- K XMY S XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")="" ;,XMY("S.VBECINTEG@FO-HINES.DOMAIN.EXT")=""
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- S XMSUB="BB CHECKSUM "_XQSUB_" at "_VBECSITE_" run on "_VBECNOW
- F I="",1 S XMTEXT="^TMP(""VBECINTEG"_I_""",$J,",XMDUZ="Blood Bank Monitor" D ^XMD
- K %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- K ^TMP("VBECINTEG",$J),^TMP("VBECINTEG1",$J)
- Q
- UPDATE ;Update checksums at a site.
- S VBI=2
- F X XMREC Q:XMER<0 S VBDEL=$S($P(XMRG,"^")?1"-".E:1,1:0),VBROU=$TR($P(XMRG,"^"),"-",""),VBCHK=$P(XMRG,"^",2) D
- . S VBECON=$$FIND1^DIC(6002.04,,"X",VBROU,,.ERROR)
- . I VBDEL S DA=VBECON,DIK="^VBEC(6002.04," D ^DIK S ^TMP("VBECINTEG",$J,VBI,0)="Routine "_VBROU_" deleted at "_VBECSITE,VBI=VBI+1 Q
- . S VBECIEN=$S(VBECON:VBECON_",",1:"+1,")
- . S FDA(1,6002.04,VBECIEN,.01)=VBROU
- . S FDA(1,6002.04,VBECIEN,1)=VBCHK
- . I 'VBECON D UPDATE^DIE("","FDA(1)",,"VBERR")
- . I VBECON D FILE^DIE("E","FDA(1)","VBERR")
- . S ^TMP("VBECINTEG",$J,VBI,0)="Routine "_VBROU_$S(VBECON:" updated to ",1:" added with ")_"checksum "_VBCHK,VBI=VBI+1
- K XMY S XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- S XMSUB="BB Checksum update at "_VBECSITE_" run on "_VBECNOW
- S XMTEXT="^TMP(""VBECINTEG"",$J,",XMDUZ="Blood Bank Monitor" D ^XMD
- K %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- K ^TMP("VBECINTEG",$J),^TMP("VBECINTEG1",$J)
- Q
- LIST ;
- S VBA=0,VBI=2 F S VBA=$O(^VBEC(6002.04,VBA)) Q:'VBA D
- . S VBDATA=$G(^VBEC(6002.04,VBA,0)),VBROU=$P(VBDATA,"^"),VBCHK=$P(VBDATA,"^",2)
- . I VBDATA="" S ^TMP("VBECINTEG",$J,VBI,0)="Record "_VBA_" damaged." Q
- . S ^TMP("VBECINTEG",$J,VBI,0)=VBECSIT1_$E(" ",1,(10-$L(VBECSIT1)))_VBROU_$E(" ",1,(10-$L(VBROU)))_VBCHK,VBI=VBI+1
- K XMY S XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- S XMSUB="BB CHECKSUM "_XQSUB_" at "_VBECSITE_" run on "_VBECNOW
- S XMTEXT="^TMP(""VBECINTEG"",$J,",XMDUZ="Blood Bank Monitor" D ^XMD
- K %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- K ^TMP("VBECINTEG",$J),^TMP("VBECINTEG1",$J)
- Q
- PATCH ;Determine Vista patch level. Expand later to include VBECS
- f VBECV=1,2 f VBECI=0:1:9999 s VBECA=$$PATCH^XPDUTL("VBEC*"_VBECV_".0*"_VBECI) i VBECA s ^TMP("VBEC",$J,(VBECI+5),0)="Patch VBEC*"_VBECV_".0*"_VBECI_" has been installed."
- K XMY S XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")="",XMY(XQSND)=""
- S %DT="T",X="NOW" D ^%DT,DD^%DT S VBECNOW=Y
- S XMSUB="VBEC Patch List at "_VBECSITE_" run on "_VBECNOW
- S XMTEXT="^TMP(""VBEC"",$J,",XMDUZ="Blood Bank Monitor" D ^XMD
- K %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- K ^TMP("VBECINTEG",$J),^TMP("VBECINTEG1",$J)
- Q
- PTCAPI(RESULTS) ;Gather patch info for transmission to VBECS
- N VBECA,VBECI,VBECV
- S (VBECCNT,X)=0
- S RESULTS=$NA(^TMP("VistAPatchList",$J))
- K @RESULTS
- D BEGROOT^VBECRPC("Patches")
- F VBECV=1,2 f VBECI=0:1:9999 s VBECA=$$PATCH^XPDUTL("VBEC*"_VBECV_".0*"_VBECI) i VBECA D
- . D BEGROOT^VBECRPC("Patch")
- . D ADD^VBECRPC("<PatchName>"_$$CHARCHK^XOBVLIB("VBEC*"_VBECV_".0*"_VBECI)_"</PatchName>")
- . D ENDROOT^VBECRPC("Patch")
- D ENDROOT^VBECRPC("Patches")
- ;
- K VBECCNT
- Q
- ZEOR ;VBECSRV
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECSRV 5829 printed Mar 13, 2025@21:49:34 Page 2
- VBECSRV ;DALLAS CIOFO/RLM - INTEGRITY CHECKER FOR BLOOD BANK ROUTINES ;08/20/2001 4:35 PM
- +1 ;;2.0;VBEC;**8**;Jun 05, 2015;Build 27
- +2 ;
- START ;
- +1 KILL ^TMP($JOB,"VBECDATA")
- +2 SET VBECSITE=$PIECE($$SITE^VASITE,U,2)
- SET VBECSIT1=$PIECE($$SITE^VASITE,U,1)
- +3 ;Determine station number
- +4 SET VBECSUB=$TRANSLATE(XQSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +5 ;Translate the subject into upper case and place it into a locally
- +6 ;namespaced variable.
- +7 SET ^TMP("VBECINTEG",$JOB,1,0)=VBECSUB_" triggered at "_VBECSITE_" by "_XMFROM_" on "_XQDATE
- +8 ;The first line of the message tells who requested the action and when.
- +9 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +10 IF VBECSUB["REPORT"
- DO REPORT
- GOTO EXIT
- +11 IF VBECSUB["UPDATE"
- DO UPDATE
- GOTO EXIT
- +12 IF VBECSUB["LIST"
- DO LIST
- GOTO EXIT
- +13 IF VBECSUB["PATCH"
- DO PATCH
- GOTO EXIT
- +14 KILL XMTEXT,XMSUB,VBECSITE,VBECNOW,XMY
- +15 ;Call a routine based on the "Subject" line of the message.
- +16 ;Skip the rest of the routine (down to exit) if the subject
- +17 ;is a valid call.
- +18 SET VBECSITE=$PIECE($$SITE^VASITE,U,2)
- SET VBECSIT1=$PIECE($$SITE^VASITE,U,1)
- +19 SET ^TMP($JOB,"VBECDATA",1)=""
- +20 SET ^TMP($JOB,"VBECDATA",2)="Sorry, but I don't know how to "_XQSUB
- +21 SET ^TMP($JOB,"VBECDATA",3)="No action taken"
- +22 SET ^TMP($JOB,"VBECDATA",3)="Invalid VBEC Server Request From "_XMFROM_" at "_VBECSITE_" run on "_VBECNOW
- +23 SET XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- +24 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +25 SET XMSUB="Invalid BB Server Request From "_XMFROM_" at "_VBECSITE_" run on "_VBECNOW
- +26 SET XMTEXT="^TMP($J,""VBECDATA"","
- SET XMDUZ="Blood Bank Monitor"
- +27 DO ^XMD
- +28 ;Send a message to the designated mail group if the server is triggered with
- +29 ;an invalid command. This lets the users know that they either made
- +30 ;a typo, or that someone is attempting to improperly invoke the server.
- EXIT KILL %DT,XMTEXT,XMSUB,VBECSITE,VBECNOW,XMY,^TMP($JOB,"VBECDATA")
- +1 QUIT
- REPORT ;report on invalid checksums at a site.
- +1 SET VBECSITE=$PIECE($$SITE^VASITE,U,2)
- SET VBECSIT1=$PIECE($$SITE^VASITE,U,1)
- +2 SET X=$TEXT(+0)
- XECUTE ^%ZOSF("RSUM1")
- SET ^TMP("VBECINTEG",$JOB,2,0)="VBECSRV at "_VBECSITE_" = "_Y
- SET ^TMP("VBECINTEG1",$JOB,3,0)="**VBECSRV^"_Y_"^^"_VBECSIT1_"^"_DT
- +3 SET VBA=0
- SET VBI=4
- FOR
- SET VBA=$ORDER(^VBEC(6002.04,VBA))
- if 'VBA
- QUIT
- SET VBDATA=$GET(^VBEC(6002.04,VBA,0))
- Begin DoDot:1
- +4 SET X=$PIECE(VBDATA,"^")
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- SET ^TMP("VBECINTEG",$JOB,VBI,0)=X_" is missing."
- SET VBI=VBI+1
- SET ^TMP("VBECINTEG1",$JOB,VBI,0)="**"_X_"^"_$PIECE(VBDATA,"^",2)_"^0^"_DT
- SET VBI=VBI+1
- QUIT
- +5 XECUTE ^%ZOSF("RSUM1")
- IF $PIECE(VBDATA,"^",2)'=Y
- SET ^TMP("VBECINTEG",$JOB,VBI,0)=X_" should be "_$PIECE(VBDATA,"^",2)_" is "_Y
- SET VBI=VBI+1
- +6 SET ^TMP("VBECINTEG1",$JOB,VBI,0)="**"_X_"^"_$PIECE(VBDATA,"^",2)_"^"_Y_"^"_VBECSIT1_"^"_DT_"^"_(Y'=$PIECE(VBDATA,"^",2))
- SET VBI=VBI+1
- End DoDot:1
- +7 ;,XMY("S.VBECINTEG@FO-HINES.DOMAIN.EXT")=""
- KILL XMY
- SET XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- +8 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +9 SET XMSUB="BB CHECKSUM "_XQSUB_" at "_VBECSITE_" run on "_VBECNOW
- +10 FOR I="",1
- SET XMTEXT="^TMP(""VBECINTEG"_I_""",$J,"
- SET XMDUZ="Blood Bank Monitor"
- DO ^XMD
- +11 KILL %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- +12 KILL ^TMP("VBECINTEG",$JOB),^TMP("VBECINTEG1",$JOB)
- +13 QUIT
- UPDATE ;Update checksums at a site.
- +1 SET VBI=2
- +2 FOR
- XECUTE XMREC
- if XMER<0
- QUIT
- SET VBDEL=$SELECT($PIECE(XMRG,"^")?1"-".E:1,1:0)
- SET VBROU=$TRANSLATE($PIECE(XMRG,"^"),"-","")
- SET VBCHK=$PIECE(XMRG,"^",2)
- Begin DoDot:1
- +3 SET VBECON=$$FIND1^DIC(6002.04,,"X",VBROU,,.ERROR)
- +4 IF VBDEL
- SET DA=VBECON
- SET DIK="^VBEC(6002.04,"
- DO ^DIK
- SET ^TMP("VBECINTEG",$JOB,VBI,0)="Routine "_VBROU_" deleted at "_VBECSITE
- SET VBI=VBI+1
- QUIT
- +5 SET VBECIEN=$SELECT(VBECON:VBECON_",",1:"+1,")
- +6 SET FDA(1,6002.04,VBECIEN,.01)=VBROU
- +7 SET FDA(1,6002.04,VBECIEN,1)=VBCHK
- +8 IF 'VBECON
- DO UPDATE^DIE("","FDA(1)",,"VBERR")
- +9 IF VBECON
- DO FILE^DIE("E","FDA(1)","VBERR")
- +10 SET ^TMP("VBECINTEG",$JOB,VBI,0)="Routine "_VBROU_$SELECT(VBECON:" updated to ",1:" added with ")_"checksum "_VBCHK
- SET VBI=VBI+1
- End DoDot:1
- +11 KILL XMY
- SET XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- +12 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +13 SET XMSUB="BB Checksum update at "_VBECSITE_" run on "_VBECNOW
- +14 SET XMTEXT="^TMP(""VBECINTEG"",$J,"
- SET XMDUZ="Blood Bank Monitor"
- DO ^XMD
- +15 KILL %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- +16 KILL ^TMP("VBECINTEG",$JOB),^TMP("VBECINTEG1",$JOB)
- +17 QUIT
- LIST ;
- +1 SET VBA=0
- SET VBI=2
- FOR
- SET VBA=$ORDER(^VBEC(6002.04,VBA))
- if 'VBA
- QUIT
- Begin DoDot:1
- +2 SET VBDATA=$GET(^VBEC(6002.04,VBA,0))
- SET VBROU=$PIECE(VBDATA,"^")
- SET VBCHK=$PIECE(VBDATA,"^",2)
- +3 IF VBDATA=""
- SET ^TMP("VBECINTEG",$JOB,VBI,0)="Record "_VBA_" damaged."
- QUIT
- +4 SET ^TMP("VBECINTEG",$JOB,VBI,0)=VBECSIT1_$EXTRACT(" ",1,(10-$LENGTH(VBECSIT1)))_VBROU_$EXTRACT(" ",1,(10-$LENGTH(VBROU)))_VBCHK
- SET VBI=VBI+1
- End DoDot:1
- +5 KILL XMY
- SET XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- +6 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +7 SET XMSUB="BB CHECKSUM "_XQSUB_" at "_VBECSITE_" run on "_VBECNOW
- +8 SET XMTEXT="^TMP(""VBECINTEG"",$J,"
- SET XMDUZ="Blood Bank Monitor"
- DO ^XMD
- +9 KILL %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- +10 KILL ^TMP("VBECINTEG",$JOB),^TMP("VBECINTEG1",$JOB)
- +11 QUIT
- PATCH ;Determine Vista patch level. Expand later to include VBECS
- +1 FOR VBECV=1,2
- FOR VBECI=0:1:9999
- SET VBECA=$$PATCH^XPDUTL("VBEC*"_VBECV_".0*"_VBECI)
- IF VBECA
- SET ^TMP("VBEC",$JOB,(VBECI+5),0)="Patch VBEC*"_VBECV_".0*"_VBECI_" has been installed."
- +2 KILL XMY
- SET XMY("G.bloodbank@FO-HINES.DOMAIN.EXT")=""
- SET XMY(XQSND)=""
- +3 SET %DT="T"
- SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET VBECNOW=Y
- +4 SET XMSUB="VBEC Patch List at "_VBECSITE_" run on "_VBECNOW
- +5 SET XMTEXT="^TMP(""VBEC"",$J,"
- SET XMDUZ="Blood Bank Monitor"
- DO ^XMD
- +6 KILL %DT,VBA,VBECNOW,VBECSITE,VBI,X,XMDUZ,XMSUB,XMTEXT,Y
- +7 KILL ^TMP("VBECINTEG",$JOB),^TMP("VBECINTEG1",$JOB)
- +8 QUIT
- PTCAPI(RESULTS) ;Gather patch info for transmission to VBECS
- +1 NEW VBECA,VBECI,VBECV
- +2 SET (VBECCNT,X)=0
- +3 SET RESULTS=$NAME(^TMP("VistAPatchList",$JOB))
- +4 KILL @RESULTS
- +5 DO BEGROOT^VBECRPC("Patches")
- +6 FOR VBECV=1,2
- FOR VBECI=0:1:9999
- SET VBECA=$$PATCH^XPDUTL("VBEC*"_VBECV_".0*"_VBECI)
- IF VBECA
- Begin DoDot:1
- +7 DO BEGROOT^VBECRPC("Patch")
- +8 DO ADD^VBECRPC("<PatchName>"_$$CHARCHK^XOBVLIB("VBEC*"_VBECV_".0*"_VBECI)_"</PatchName>")
- +9 DO ENDROOT^VBECRPC("Patch")
- End DoDot:1
- +10 DO ENDROOT^VBECRPC("Patches")
- +11 ;
- +12 KILL VBECCNT
- +13 QUIT
- ZEOR ;VBECSRV
