PXVWSTAT ;ISP/LMT - Manage Status of ICE Interface ;12/13/17 12:24
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
LOGSTAT(DFN) ; Log if call succeeded or failed
;
N PXNOW,PXRETCODE,PXSUB,PXSUCCESS
;
S PXSUB="PXICESTAT-"_DT
S PXNOW=$$NOW^XLFDT()
;
S PXSUCCESS=1
S PXRETCODE=$P($G(^TMP("PXICEWEB",$J,0)),U,1)
; Should we only consider fail if -2, -3, and -4?
I PXRETCODE<0 S PXSUCCESS=0
I PXRETCODE=-6 Q
;
L +^XTMP(PXSUB):DILOCKTM
;
I '$D(^XTMP(PXSUB)) D
. S ^XTMP(PXSUB,0)=$$FMADD^XLFDT(PXNOW,30)_U_PXNOW_U_"ICE Web Stat Log"
. ;M ^XTMP(PXSUB,"LAST")=^XTMP("PXICESTAT-"_$$FMADD^XLFDT(DT,-1),"LAST")
;
I PXSUCCESS D
. ;I '$$ISUP() D ENABLE
. S ^XTMP(PXSUB,"TOTAL","SUCCESS")=$G(^XTMP(PXSUB,"TOTAL","SUCCESS"))+1
. ;S ^XTMP(PXSUB,"LAST","SUCCESS")=PXNOW
. ;K ^XTMP(PXSUB,"LAST","FAIL")
. S ^XTMP(PXSUB,"LAST")=1_U_PXNOW
;
I 'PXSUCCESS D
. S ^XTMP(PXSUB,"TOTAL","FAIL")=$G(^XTMP(PXSUB,"TOTAL","FAIL"))+1
. ;I $D(^XTMP(PXSUB,"LAST","FAIL")),DFN'=$P($G(^XTMP(PXSUB,"LAST","FAIL")),U,2) D
. ;. ; if ICE is enabled, mark ICE as unavailable
. ;. I $$CHKSTAT() D UNAVLBL
. ;S ^XTMP(PXSUB,"LAST","FAIL")=PXNOW_U_DFN
. I $P($G(^XTMP(PXSUB,"LAST")),U,1)=0,DFN'=$P($G(^XTMP(PXSUB,"LAST")),U,3) D
. . ; if ICE is enabled, mark ICE as unavailable
. . I $$CHKSTAT() D UNAVLBL
. ;
. S ^XTMP(PXSUB,"LAST")=0_U_PXNOW_U_DFN
;
L -^XTMP(PXSUB)
;
Q
;
;
RESTORE ; Mark ICE interface as up
;
;enable interface
D UPDSTAT(1)
;send bulletin
D SMSGRST
;
Q
;
;
UNAVLBL ; Mark ICE interface as down due to too many failed attempts
;
N PXDESC,PXFREQ,PXRTN,PXTASK,PXVARS,PXVOTH
;
;mark interface as unavailable
D UPDSTAT(2)
;
;send bulletin
D SMSGDWN
;
; Task job to run every 15 to test if ICE is back up
S PXRTN="TASKTST^PXVWSTAT"
S PXDESC="Test Immunization Calculation Engine (ICE)"
S PXFREQ=15 ;Frequency (in min) to check if ICE is back up
S PXVARS="PXFREQ"
S PXVOTH("ZTDTH")=$$HADD^XLFDT($H,0,0,PXFREQ,0)
S PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVARS,.PXVOTH)
;
Q
;
;
SMSGDWN ; send a bulletin that ICE Interface connection is down.
;
N PXFDB,XMB,XMBTMP,XMDF,XMDT,XMTEXT,XMY,XMYBLOB,XMV,XMDUZ
;
S XMDUZ="PX ICE MANAGER"
S XMB="PX ICE INTERFACE DOWN"
S XMTEXT="PXFDB"
S PXFDB(1)="Connection to the Immunization Calculation Engine (ICE) is down! The"
S PXFDB(2)="ICE immunization recommendations will not be able to be utilized until"
S PXFDB(3)="the connection is reestablished!!!"
S XMY("G.PXRM MANAGER")="" ;TODO: CHANGE
D ^XMB
;
Q
;
;
SMSGRST ; send a bulletin that ICE Interface connection is restored
N PXFDB,XMB,XMBTMP,XMDF,XMDT,XMTEXT,XMY,XMYBLOB,XMV,XMDUZ
S XMDUZ="PX ICE MANAGER"
S XMB="PX ICE INTERFACE RESTORED"
S XMTEXT="PXFDB"
S PXFDB(1)="Connection to the Immunization Calculation Engine (ICE) has been restored!"
S PXFDB(2)="The ICE immunization recommendations can now be utilized."
S XMY("G.PXRM MANAGER")="" ;TODO: CHANGE
D ^XMB
Q
;
;
CHKSTAT() ; Return ICE Status
; 0 - Disabled
; 1 - Enabled
; 0^1 - Enabled/Unavailable
N PXSTATUS
S PXSTATUS=$P($G(^PXV(920.76,1,0)),U,1)
I PXSTATUS=2 S PXSTATUS="0^1"
Q PXSTATUS
;
;
TASKTST ; Tasked job to test ICE
;
; ZEXCEPT: PXFREQ,ZTQUEUED,ZTREQ
N PXSUCCESS
;
S ZTREQ="@"
;
; If ICE is enabled or disabled, quit.
; only check ICE availability when status=enabled/unavailable
I $$CHKSTAT()'="0^1" Q
;
S PXSUCCESS=$$TESTICE^PXVWICE()
;
I PXSUCCESS D Q
. D RESTORE
;
S PXFREQ=$G(PXFREQ,15)
I 'PXSUCCESS D
. S ZTREQ=$$HADD^XLFDT($H,0,0,PXFREQ,0)
;
Q
;
;
UPDSTAT(PXSTATUS,PXDT,PXUSER) ;
;
N PXFDA,PXIEN,PXIENS
;
I $G(PXSTATUS)'?1(1"0",1"1",1"2") Q
I '$G(PXDT) S PXDT=$$NOW^XLFDT()
S PXUSER=$G(PXUSER)
;
S PXIENS="1,"
I '$D(^PXV(920.76,1,0)) D
. S PXIENS="+1,"
. S PXIEN(1)=1
;
S PXFDA(920.76,PXIENS,.01)=PXSTATUS
S PXIENS="+2,"_PXIENS
S PXFDA(920.761,PXIENS,.01)=PXDT
S PXFDA(920.761,PXIENS,.02)=PXUSER
S PXFDA(920.761,PXIENS,.03)=PXSTATUS
;
L +^PXV(920.76,1):DILOCKTM
; If interface is disabled, do not let the status be changed
; to enabled/unavailable
I $P($G(^PXV(920.76,1,0)),U,1)=0,PXSTATUS=2 D Q
. L -^PXV(920.76,1)
D UPDATE^DIE("U","PXFDA","PXIEN")
L -^PXV(920.76,1)
;
Q
;
;
ENCHGSTA ; Entry for a user to enable/disable the ICE interface
;
N PXNEWSTAT,PXOLDSTAT,PXSUCCESS
;
S PXOLDSTAT=$$CHKSTAT()
I PXOLDSTAT="0^1" S PXOLDSTAT=2
;
L +^PXV(920.76,1):DILOCKTM
I '$T D Q
. W !,"Another terminal is modifying this field!"
;
S PXNEWSTAT=$$ASKCHNGE(PXOLDSTAT)
;
I PXNEWSTAT'=-1,PXNEWSTAT'=PXOLDSTAT D UPDSTAT(PXNEWSTAT,$$NOW^XLFDT(),DUZ)
;
I PXOLDSTAT=0,PXNEWSTAT=1 D
. W !,"Please wait while we test the ICE interface..."
. S PXSUCCESS=$$TESTICE^PXVWICE()
. I PXSUCCESS W !!,"Connection to ICE was successful.",!!
. I 'PXSUCCESS W !!,"Connection could not be made to ICE.",!!
. H 1
;
L -^PXV(920.76,1)
;
Q
;
;
ASKCHNGE(PXOLDSTAT) ; Ask the user if they want to enable/disable the ICE interface
;
N DIR,DIRUT,PXNEWSTAT,Y
;
S PXNEWSTAT=PXOLDSTAT
;
; Display old status
W !!,"The connection to ICE is currently "_$S('PXOLDSTAT:"DISABLED",1:"ENABLED")_"."
I PXOLDSTAT=2 W !,"However, the systems is currently having issues connecting to ICE."
W !
;
; Ask if user wants to change status
S DIR(0)="Y^A"
S DIR("A")="Do you wish to "_$S('PXOLDSTAT:"ENABLE",1:"DISABLE")_" the interface to ICE"
S DIR("B")=$S(PXOLDSTAT:"NO",1:"YES")
S DIR("?")="Enter either 'Y' or 'N'. This will control if the interface to the Immunization Calculation Engine (ICE) is enabled or disabled."
D ^DIR
I $D(DIRUT)!('$G(Y)) Q -1
;
; Confirm
K DIR,Y
S DIR(0)="Y^A"
S DIR("B")="NO"
S DIR("A")="Are you sure you want to "_$S('PXOLDSTAT:"ENABLE",1:"DISABLE")_" the ICE interface"
D ^DIR
W !
I $D(DIRUT)!('$G(Y)) Q -1
;
S PXNEWSTAT='PXOLDSTAT
;
Q PXNEWSTAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWSTAT 6025 printed Apr 09, 2024@21:27:27 Page 2
PXVWSTAT ;ISP/LMT - Manage Status of ICE Interface ;12/13/17 12:24
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
LOGSTAT(DFN) ; Log if call succeeded or failed
+1 ;
+2 NEW PXNOW,PXRETCODE,PXSUB,PXSUCCESS
+3 ;
+4 SET PXSUB="PXICESTAT-"_DT
+5 SET PXNOW=$$NOW^XLFDT()
+6 ;
+7 SET PXSUCCESS=1
+8 SET PXRETCODE=$PIECE($GET(^TMP("PXICEWEB",$JOB,0)),U,1)
+9 ; Should we only consider fail if -2, -3, and -4?
+10 IF PXRETCODE<0
SET PXSUCCESS=0
+11 IF PXRETCODE=-6
QUIT
+12 ;
+13 LOCK +^XTMP(PXSUB):DILOCKTM
+14 ;
+15 IF '$DATA(^XTMP(PXSUB))
Begin DoDot:1
+16 SET ^XTMP(PXSUB,0)=$$FMADD^XLFDT(PXNOW,30)_U_PXNOW_U_"ICE Web Stat Log"
+17 ;M ^XTMP(PXSUB,"LAST")=^XTMP("PXICESTAT-"_$$FMADD^XLFDT(DT,-1),"LAST")
End DoDot:1
+18 ;
+19 IF PXSUCCESS
Begin DoDot:1
+20 ;I '$$ISUP() D ENABLE
+21 SET ^XTMP(PXSUB,"TOTAL","SUCCESS")=$GET(^XTMP(PXSUB,"TOTAL","SUCCESS"))+1
+22 ;S ^XTMP(PXSUB,"LAST","SUCCESS")=PXNOW
+23 ;K ^XTMP(PXSUB,"LAST","FAIL")
+24 SET ^XTMP(PXSUB,"LAST")=1_U_PXNOW
End DoDot:1
+25 ;
+26 IF 'PXSUCCESS
Begin DoDot:1
+27 SET ^XTMP(PXSUB,"TOTAL","FAIL")=$GET(^XTMP(PXSUB,"TOTAL","FAIL"))+1
+28 ;I $D(^XTMP(PXSUB,"LAST","FAIL")),DFN'=$P($G(^XTMP(PXSUB,"LAST","FAIL")),U,2) D
+29 ;. ; if ICE is enabled, mark ICE as unavailable
+30 ;. I $$CHKSTAT() D UNAVLBL
+31 ;S ^XTMP(PXSUB,"LAST","FAIL")=PXNOW_U_DFN
+32 IF $PIECE($GET(^XTMP(PXSUB,"LAST")),U,1)=0
IF DFN'=$PIECE($GET(^XTMP(PXSUB,"LAST")),U,3)
Begin DoDot:2
+33 ; if ICE is enabled, mark ICE as unavailable
+34 IF $$CHKSTAT()
DO UNAVLBL
End DoDot:2
+35 ;
+36 SET ^XTMP(PXSUB,"LAST")=0_U_PXNOW_U_DFN
End DoDot:1
+37 ;
+38 LOCK -^XTMP(PXSUB)
+39 ;
+40 QUIT
+41 ;
+42 ;
RESTORE ; Mark ICE interface as up
+1 ;
+2 ;enable interface
+3 DO UPDSTAT(1)
+4 ;send bulletin
+5 DO SMSGRST
+6 ;
+7 QUIT
+8 ;
+9 ;
UNAVLBL ; Mark ICE interface as down due to too many failed attempts
+1 ;
+2 NEW PXDESC,PXFREQ,PXRTN,PXTASK,PXVARS,PXVOTH
+3 ;
+4 ;mark interface as unavailable
+5 DO UPDSTAT(2)
+6 ;
+7 ;send bulletin
+8 DO SMSGDWN
+9 ;
+10 ; Task job to run every 15 to test if ICE is back up
+11 SET PXRTN="TASKTST^PXVWSTAT"
+12 SET PXDESC="Test Immunization Calculation Engine (ICE)"
+13 ;Frequency (in min) to check if ICE is back up
SET PXFREQ=15
+14 SET PXVARS="PXFREQ"
+15 SET PXVOTH("ZTDTH")=$$HADD^XLFDT($HOROLOG,0,0,PXFREQ,0)
+16 SET PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVARS,.PXVOTH)
+17 ;
+18 QUIT
+19 ;
+20 ;
SMSGDWN ; send a bulletin that ICE Interface connection is down.
+1 ;
+2 NEW PXFDB,XMB,XMBTMP,XMDF,XMDT,XMTEXT,XMY,XMYBLOB,XMV,XMDUZ
+3 ;
+4 SET XMDUZ="PX ICE MANAGER"
+5 SET XMB="PX ICE INTERFACE DOWN"
+6 SET XMTEXT="PXFDB"
+7 SET PXFDB(1)="Connection to the Immunization Calculation Engine (ICE) is down! The"
+8 SET PXFDB(2)="ICE immunization recommendations will not be able to be utilized until"
+9 SET PXFDB(3)="the connection is reestablished!!!"
+10 ;TODO: CHANGE
SET XMY("G.PXRM MANAGER")=""
+11 DO ^XMB
+12 ;
+13 QUIT
+14 ;
+15 ;
SMSGRST ; send a bulletin that ICE Interface connection is restored
+1 NEW PXFDB,XMB,XMBTMP,XMDF,XMDT,XMTEXT,XMY,XMYBLOB,XMV,XMDUZ
+2 SET XMDUZ="PX ICE MANAGER"
+3 SET XMB="PX ICE INTERFACE RESTORED"
+4 SET XMTEXT="PXFDB"
+5 SET PXFDB(1)="Connection to the Immunization Calculation Engine (ICE) has been restored!"
+6 SET PXFDB(2)="The ICE immunization recommendations can now be utilized."
+7 ;TODO: CHANGE
SET XMY("G.PXRM MANAGER")=""
+8 DO ^XMB
+9 QUIT
+10 ;
+11 ;
CHKSTAT() ; Return ICE Status
+1 ; 0 - Disabled
+2 ; 1 - Enabled
+3 ; 0^1 - Enabled/Unavailable
+4 NEW PXSTATUS
+5 SET PXSTATUS=$PIECE($GET(^PXV(920.76,1,0)),U,1)
+6 IF PXSTATUS=2
SET PXSTATUS="0^1"
+7 QUIT PXSTATUS
+8 ;
+9 ;
TASKTST ; Tasked job to test ICE
+1 ;
+2 ; ZEXCEPT: PXFREQ,ZTQUEUED,ZTREQ
+3 NEW PXSUCCESS
+4 ;
+5 SET ZTREQ="@"
+6 ;
+7 ; If ICE is enabled or disabled, quit.
+8 ; only check ICE availability when status=enabled/unavailable
+9 IF $$CHKSTAT()'="0^1"
QUIT
+10 ;
+11 SET PXSUCCESS=$$TESTICE^PXVWICE()
+12 ;
+13 IF PXSUCCESS
Begin DoDot:1
+14 DO RESTORE
End DoDot:1
QUIT
+15 ;
+16 SET PXFREQ=$GET(PXFREQ,15)
+17 IF 'PXSUCCESS
Begin DoDot:1
+18 SET ZTREQ=$$HADD^XLFDT($HOROLOG,0,0,PXFREQ,0)
End DoDot:1
+19 ;
+20 QUIT
+21 ;
+22 ;
UPDSTAT(PXSTATUS,PXDT,PXUSER) ;
+1 ;
+2 NEW PXFDA,PXIEN,PXIENS
+3 ;
+4 IF $GET(PXSTATUS)'?1(1"0",1"1",1"2")
QUIT
+5 IF '$GET(PXDT)
SET PXDT=$$NOW^XLFDT()
+6 SET PXUSER=$GET(PXUSER)
+7 ;
+8 SET PXIENS="1,"
+9 IF '$DATA(^PXV(920.76,1,0))
Begin DoDot:1
+10 SET PXIENS="+1,"
+11 SET PXIEN(1)=1
End DoDot:1
+12 ;
+13 SET PXFDA(920.76,PXIENS,.01)=PXSTATUS
+14 SET PXIENS="+2,"_PXIENS
+15 SET PXFDA(920.761,PXIENS,.01)=PXDT
+16 SET PXFDA(920.761,PXIENS,.02)=PXUSER
+17 SET PXFDA(920.761,PXIENS,.03)=PXSTATUS
+18 ;
+19 LOCK +^PXV(920.76,1):DILOCKTM
+20 ; If interface is disabled, do not let the status be changed
+21 ; to enabled/unavailable
+22 IF $PIECE($GET(^PXV(920.76,1,0)),U,1)=0
IF PXSTATUS=2
Begin DoDot:1
+23 LOCK -^PXV(920.76,1)
End DoDot:1
QUIT
+24 DO UPDATE^DIE("U","PXFDA","PXIEN")
+25 LOCK -^PXV(920.76,1)
+26 ;
+27 QUIT
+28 ;
+29 ;
ENCHGSTA ; Entry for a user to enable/disable the ICE interface
+1 ;
+2 NEW PXNEWSTAT,PXOLDSTAT,PXSUCCESS
+3 ;
+4 SET PXOLDSTAT=$$CHKSTAT()
+5 IF PXOLDSTAT="0^1"
SET PXOLDSTAT=2
+6 ;
+7 LOCK +^PXV(920.76,1):DILOCKTM
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !,"Another terminal is modifying this field!"
End DoDot:1
QUIT
+10 ;
+11 SET PXNEWSTAT=$$ASKCHNGE(PXOLDSTAT)
+12 ;
+13 IF PXNEWSTAT'=-1
IF PXNEWSTAT'=PXOLDSTAT
DO UPDSTAT(PXNEWSTAT,$$NOW^XLFDT(),DUZ)
+14 ;
+15 IF PXOLDSTAT=0
IF PXNEWSTAT=1
Begin DoDot:1
+16 WRITE !,"Please wait while we test the ICE interface..."
+17 SET PXSUCCESS=$$TESTICE^PXVWICE()
+18 IF PXSUCCESS
WRITE !!,"Connection to ICE was successful.",!!
+19 IF 'PXSUCCESS
WRITE !!,"Connection could not be made to ICE.",!!
+20 HANG 1
End DoDot:1
+21 ;
+22 LOCK -^PXV(920.76,1)
+23 ;
+24 QUIT
+25 ;
+26 ;
ASKCHNGE(PXOLDSTAT) ; Ask the user if they want to enable/disable the ICE interface
+1 ;
+2 NEW DIR,DIRUT,PXNEWSTAT,Y
+3 ;
+4 SET PXNEWSTAT=PXOLDSTAT
+5 ;
+6 ; Display old status
+7 WRITE !!,"The connection to ICE is currently "_$SELECT('PXOLDSTAT:"DISABLED",1:"ENABLED")_"."
+8 IF PXOLDSTAT=2
WRITE !,"However, the systems is currently having issues connecting to ICE."
+9 WRITE !
+10 ;
+11 ; Ask if user wants to change status
+12 SET DIR(0)="Y^A"
+13 SET DIR("A")="Do you wish to "_$SELECT('PXOLDSTAT:"ENABLE",1:"DISABLE")_" the interface to ICE"
+14 SET DIR("B")=$SELECT(PXOLDSTAT:"NO",1:"YES")
+15 SET DIR("?")="Enter either 'Y' or 'N'. This will control if the interface to the Immunization Calculation Engine (ICE) is enabled or disabled."
+16 DO ^DIR
+17 IF $DATA(DIRUT)!('$GET(Y))
QUIT -1
+18 ;
+19 ; Confirm
+20 KILL DIR,Y
+21 SET DIR(0)="Y^A"
+22 SET DIR("B")="NO"
+23 SET DIR("A")="Are you sure you want to "_$SELECT('PXOLDSTAT:"ENABLE",1:"DISABLE")_" the ICE interface"
+24 DO ^DIR
+25 WRITE !
+26 IF $DATA(DIRUT)!('$GET(Y))
QUIT -1
+27 ;
+28 SET PXNEWSTAT='PXOLDSTAT
+29 ;
+30 QUIT PXNEWSTAT
