| [613] | 1 | HLEVSRV4 ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | LICEXT ; Change license date... (Resets CODEXP,EXPNOW)
|
|---|
| 5 | N CUT
|
|---|
| 6 | W !
|
|---|
| 7 | S CUT=$$ASKDATE^HLEVAPI2("Enter NEW CUTOFF DATE/TIME","EXT")
|
|---|
| 8 | I CUT'?7N1"."1.N W " no action taken..." QUIT ;->
|
|---|
| 9 | S $P(^XTMP(XTMP,"CODE"),U)=CUT
|
|---|
| 10 | S ^XTMP(XTMP,0)=$$FMADD^XLFDT(CUT,7)_U_$$NOW^XLFDT_U_"VistA HL7 Remote Request License"
|
|---|
| 11 | S ^XTMP(XTMP,"USER")=$$NOW^XLFDT_U_DUZ
|
|---|
| 12 | W !!,"The current license has been changed to "
|
|---|
| 13 | W $$FMTE^XLFDT(CUT),"..."
|
|---|
| 14 | S CODEXP=CUT,EXPNOW=$S(CUT>NOW:0,1:1)
|
|---|
| 15 | D SETLIC^HLEVSRV3(CODEXP_U_CODE)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | LICUSER ; Enter new users now...
|
|---|
| 19 | ; IOINHI,IOINORM -- req
|
|---|
| 20 | N POSX,USER
|
|---|
| 21 | ;
|
|---|
| 22 | W !!,"Enter the email address of the recipient(s). (Enter the address of an"
|
|---|
| 23 | W !,"existing user and they will be removed.)"
|
|---|
| 24 | W !!,IOINHI,"Hint:",IOINORM," "
|
|---|
| 25 | S POSX=8
|
|---|
| 26 | W "You may enter ""something"" that is less exact than the complete"
|
|---|
| 27 | W !,?POSX,"email address and not compromise security. For example, if"
|
|---|
| 28 | W !,?POSX,"the remote requester is named 'John Doe' and will be sending"
|
|---|
| 29 | W !,?POSX,"requests from the Buffalo VAMC, you still might not know"
|
|---|
| 30 | W !,?POSX,"the exact email address to enter. (E.g., Should you enter"
|
|---|
| 31 | W !,?POSX,"'JOHN.DOE@MED.VA.GOV' or 'DOE.JOHN@BUFFALO.VA.GOV'?) And, this"
|
|---|
| 32 | W !,?POSX,"is why it is often advantageous to enter something like"
|
|---|
| 33 | W !,?POSX,"'DOE@BUFFALO' and also 'DOE@MED.VA.GOV'. When a remote "
|
|---|
| 34 | W !,?POSX,"request is received, as long as 'DOE' is in the sender's"
|
|---|
| 35 | W !,?POSX,"name, and either 'BUFFALO' or 'MED.VA.GOV' is in the"
|
|---|
| 36 | W !,?POSX,"address, it will be honored."
|
|---|
| 37 | W !
|
|---|
| 38 | ;
|
|---|
| 39 | F D QUIT:USER']""
|
|---|
| 40 | . S USER=$$FT^HLEVSRV2("Enter REMOTE ADDRESS","","O")
|
|---|
| 41 | . I USER']""!(USER[U) S USER="" QUIT ;->
|
|---|
| 42 | . I USER'?1.E1"@"1.E D QUIT ;->
|
|---|
| 43 | . . W !!,?5,"No action taken! (Use 'NAME@ADDRESS' format.)"
|
|---|
| 44 | . . W !
|
|---|
| 45 | . S USER=$$UP^XLFSTR(USER)
|
|---|
| 46 | . I $D(^XTMP(XTMP,"USER",USER)) D QUIT ;->
|
|---|
| 47 | . . KILL ^XTMP(XTMP,"USER",USER)
|
|---|
| 48 | . . W " removed..."
|
|---|
| 49 | . S ^XTMP(XTMP,"USER",USER)=$$NOW^XLFDT_U_$G(DUZ)
|
|---|
| 50 | . W " added..."
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | LICNEW ; Create new license... (Creates CODE,CODEXP,EXPNOW)
|
|---|
| 54 | ;
|
|---|
| 55 | I $G(^XTMP(XTMP,"CODE"))]"" D I '$$YN^HLCSRPT4("Continue","No") W " no action taken..." QUIT ;->
|
|---|
| 56 | . W !!,IOINHI,"Warning!!",IOINORM
|
|---|
| 57 | . W " The current license, along with all licensed requesters, will"
|
|---|
| 58 | . W " be deleted if you continue."
|
|---|
| 59 | . W !
|
|---|
| 60 | ;
|
|---|
| 61 | S (CODEXP,EXPNOW)="",CODE=$$CODE^HLEVSRV3
|
|---|
| 62 | W !!,"License '",IOINHI,CODE,IOINORM,"' will be used after you enter cutoff date..."
|
|---|
| 63 | W !!,"Defaulting 'NOW + 7 days' below..."
|
|---|
| 64 | W !
|
|---|
| 65 | S CODEXP=$$ASKDATE^HLEVAPI2("Enter CUTOFF DATE","EXT",$P($$FMTE^XLFDT(+$$FMADD^XLFDT($$NOW^XLFDT,7)),":",1,2))
|
|---|
| 66 | I CODEXP'?7N1"."1.N S (CODE,CODEXP,EXPNOW)="" QUIT ;->
|
|---|
| 67 | ; Accept any date. For user will have opportunity to change later.
|
|---|
| 68 | S EXPNOW=$S(CODEXP<NOW:1,1:0) ; Is license expired?
|
|---|
| 69 | D SETLIC^HLEVSRV3(CODEXP_U_CODE)
|
|---|
| 70 | ;
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | LICAN ; Cancel current license...
|
|---|
| 74 | ; XTMP -- req
|
|---|
| 75 | ;
|
|---|
| 76 | ; If no license exists...
|
|---|
| 77 | I '$D(^XTMP(XTMP)) D QUIT ;->
|
|---|
| 78 | . W !,"No license exists..."
|
|---|
| 79 | ;
|
|---|
| 80 | W !!,"If you cancel license, the code and all requesters will be removed!"
|
|---|
| 81 | W !
|
|---|
| 82 | I '$$YN^HLCSRPT4("OK to cancel license","No") D QUIT ;->
|
|---|
| 83 | . W " no action taken..."
|
|---|
| 84 | ;
|
|---|
| 85 | KILL ^XTMP(XTMP)
|
|---|
| 86 | W " license canceled..."
|
|---|
| 87 | S (CODE,CODEXP,EXPNOW)=""
|
|---|
| 88 | ;
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | CHKLIC(CODEXM,FROM) ; Called by server action to see if passed in license
|
|---|
| 92 | ; matches current license. If so, data will be returned to
|
|---|
| 93 | ; requester. If not, a refusal email will be returned to XMFROM.
|
|---|
| 94 | N OXMZ,OXTMP
|
|---|
| 95 | ;
|
|---|
| 96 | S OXMZ=$G(XMZ),OXTMP=$G(XTMP)
|
|---|
| 97 | ;
|
|---|
| 98 | N CODE,CUT,NOW,XTMP
|
|---|
| 99 | ;
|
|---|
| 100 | S XTMP="HLEV REMOTE LICENSE",NOW=$$NOW^XLFDT
|
|---|
| 101 | S CODE=$G(^XTMP(XTMP,"CODE")),CUT=+CODE,CODE=$P(CODE,U,2,999)
|
|---|
| 102 | ;
|
|---|
| 103 | ; If no requester known...
|
|---|
| 104 | I $G(XMFROM)']"" D QUIT ;->
|
|---|
| 105 | . D REFUSE("requester unknown.")
|
|---|
| 106 | ;
|
|---|
| 107 | ; If no code exists...
|
|---|
| 108 | I CODE']"" D QUIT ;->
|
|---|
| 109 | . D REFUSE("no license exists.")
|
|---|
| 110 | ;
|
|---|
| 111 | ; License has expired...
|
|---|
| 112 | I CUT<NOW D REFUSE("the current license has expired.") QUIT ;->
|
|---|
| 113 | ;
|
|---|
| 114 | ; Incorrect code sent by remote requester...
|
|---|
| 115 | I CODEXM'=CODE D REFUSE("incorrect code received.") QUIT ;->
|
|---|
| 116 | ;
|
|---|
| 117 | ; Is remote requester licensed?
|
|---|
| 118 | I '$$LICENSED($G(XMFROM)) D QUIT ;->
|
|---|
| 119 | . D REFUSE("Requester is not licensed.")
|
|---|
| 120 | ;
|
|---|
| 121 | ; Set XMY so report returned to remote requester...
|
|---|
| 122 | I $G(XMFROM)]"" S XMY(XMFROM)=""
|
|---|
| 123 | ;
|
|---|
| 124 | D RECXTMP("Request# "_XMZ_" from "_$G(XMFROM)_" honored. ["_OXTMP_"]")
|
|---|
| 125 | ;
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | LICENSED(FROM) ; Is requester licensed?
|
|---|
| 129 | N OK,USER
|
|---|
| 130 | S FROM=$$UP^XLFSTR(FROM)
|
|---|
| 131 | S ADDR=$P(FROM,"@",2) QUIT:ADDR']"" "" ;->
|
|---|
| 132 | S FROM=$P(FROM,"@") QUIT:FROM']"" "" ;->
|
|---|
| 133 | S OK=0,USER=""
|
|---|
| 134 | F S USER=$O(^XTMP(XTMP,"USER",USER)) Q:USER']""!(OK) D
|
|---|
| 135 | . S FROM(1)=$P(USER,"@"),ADDR(1)=$P(USER,"@",2)
|
|---|
| 136 | . QUIT:FROM'[FROM(1) ;-> License NAME not in XMFROM
|
|---|
| 137 | . QUIT:ADDR'[ADDR(1) ;-> License ADDR not in XMFROM
|
|---|
| 138 | . S OK=1
|
|---|
| 139 | Q $S(OK:1,1:"")
|
|---|
| 140 | ;
|
|---|
| 141 | REFUSE(REA) ; Send refusal email back to remote requester...
|
|---|
| 142 | ; XMFROM,XTMP -- req
|
|---|
| 143 | N HOLD,NO,TEXT,XMDUZ,XMSUB,XMTEXT
|
|---|
| 144 | ;
|
|---|
| 145 | D RECXTMP("Refused ("_REA_") Request# "_$G(XMZ)_" from "_$G(XMFROM))
|
|---|
| 146 | ;
|
|---|
| 147 | N XMZ
|
|---|
| 148 | S XMDUZ=.5,XMSUB="HL7 Remote Request Refusal: "_$G(XMFROM)
|
|---|
| 149 | S XMTEXT="HOLD("
|
|---|
| 150 | ;
|
|---|
| 151 | D MAILADD("The following remote request for VistA HL7 data has been refused.")
|
|---|
| 152 | D MAILADD("Details are included below."),MAILADD("")
|
|---|
| 153 | D MAILADD(" Requester: "_$G(XMFROM))
|
|---|
| 154 | D MAILADD(" Message#: "_$G(OXMZ))
|
|---|
| 155 | D MAILADD(" Reason: "_REA)
|
|---|
| 156 | ;
|
|---|
| 157 | S XMY("HL7SystemMonitoring@med.va.gov")=""
|
|---|
| 158 | I $G(XMFROM)]"" S XMY(XMFROM)=""
|
|---|
| 159 | ;
|
|---|
| 160 | D ^XMD
|
|---|
| 161 | ;
|
|---|
| 162 | QUIT
|
|---|
| 163 | ;
|
|---|
| 164 | MAILADD(T) S NO=$O(HOLD(":"),-1)+1,HOLD(NO)=T
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | RECXTMP(TXT) ; Record in ^XTMP for remote requests...
|
|---|
| 168 | ; XTMP -- req
|
|---|
| 169 | S NO=$O(^XTMP(XTMP,"REQ",":"),-1)+1
|
|---|
| 170 | S ^XTMP(XTMP,"REQ",+NO)=TXT
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | EOR ;HLEVSRV4 - Event Monitor SERVER ;5/16/03 14:42
|
|---|
