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 Dec 13, 2024@02:44:37 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
