| 1 | PPPMSC1 ;ALB/DMB - MISC PPP UTILITIES ; 2/12/92
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | LOGEVNT(EVNTCODE,ROUTINE,TEXT) ; Log an event to the log file
|
|---|
| 6 | ;
|
|---|
| 7 | N DIC,X,Y,PARMERR,FMERR,DTOUT,DUOUT
|
|---|
| 8 | ;
|
|---|
| 9 | S PARMERR=-9001
|
|---|
| 10 | S FMERR=-9002
|
|---|
| 11 | ;
|
|---|
| 12 | ; Make sure the parameters are valid
|
|---|
| 13 | ;
|
|---|
| 14 | I '$D(^PPP(1020.6,"B",EVNTCODE)) S EVNTCODE=9999
|
|---|
| 15 | I '$D(TEXT) S TEXT=""
|
|---|
| 16 | I $D(TEXT),($L(TEXT))>245 Q PARMERR
|
|---|
| 17 | I '$D(ROUTINE) S ROUTINE=""
|
|---|
| 18 | ;
|
|---|
| 19 | ; Update DT so it has the correct date.
|
|---|
| 20 | ;
|
|---|
| 21 | D NOW^%DTC S DT=X K %,%H,%I,X
|
|---|
| 22 | ;
|
|---|
| 23 | S DIC="^PPP(1020.4,"
|
|---|
| 24 | S X=$O(^PPP(1020.6,"B",EVNTCODE,""))
|
|---|
| 25 | S DIC(0)=""
|
|---|
| 26 | I $D(TEXT) S DIC("DR")="4///"_ROUTINE_";5///"_TEXT
|
|---|
| 27 | K DD,DO ; -- required by FILE^DICN call
|
|---|
| 28 | D FILE^DICN
|
|---|
| 29 | ;
|
|---|
| 30 | I (Y=-1)!($D(DTOUT))!($D(DUOUT)) Q FMERR
|
|---|
| 31 | Q 0
|
|---|
| 32 | ;
|
|---|
| 33 | STATUPDT(CODE,INCRMNT) ; Update statistics in stat file.
|
|---|
| 34 | ;
|
|---|
| 35 | ; This function is used to increment a specific statistic
|
|---|
| 36 | ; by the amount passed in INCRMNT. The statistics are currently
|
|---|
| 37 | ; referenced by the FileMan field number. They are currently
|
|---|
| 38 | ; defined as follows:
|
|---|
| 39 | ;
|
|---|
| 40 | ; 2 - Total PDX's Sent
|
|---|
| 41 | ; 3 - Total Alerts Issued
|
|---|
| 42 | ; 4 - Total Alerts Ignored
|
|---|
| 43 | ; 5 - Total Manual Entries Added
|
|---|
| 44 | ; 6 - Total Entries Deleted
|
|---|
| 45 | ; 7 - Total Entries Edited
|
|---|
| 46 | ; 8 - Total New Patients Added
|
|---|
| 47 | ; 9 - Total FMP's Viewed/Printed
|
|---|
| 48 | ;
|
|---|
| 49 | ; Return Values:
|
|---|
| 50 | ;
|
|---|
| 51 | ; 0 - Normal Termination
|
|---|
| 52 | ; -9001 - Input Parameter Error
|
|---|
| 53 | ; -9002 - Fileman Error
|
|---|
| 54 | ;
|
|---|
| 55 | N DA,DIC,DIE,DIDEL,DIQ,DR,ERR,PPPTMP,VAL,PARMERR,FMERR,PPPTMP
|
|---|
| 56 | ;
|
|---|
| 57 | S PARMERR=-9001
|
|---|
| 58 | S FMERR=-9002
|
|---|
| 59 | S ERR=0
|
|---|
| 60 | ;
|
|---|
| 61 | I '$D(CODE)!('$D(INCRMNT)) Q PARMERR
|
|---|
| 62 | I CODE<2!(CODE>9) Q PARMERR
|
|---|
| 63 | I '$D(INCRMNT) Q PARMERR
|
|---|
| 64 | I INCRMNT'>0 Q PARMERR
|
|---|
| 65 | ;
|
|---|
| 66 | ; Get the current value of the statistic
|
|---|
| 67 | ;
|
|---|
| 68 | S DIC=1020.3
|
|---|
| 69 | S DR=CODE
|
|---|
| 70 | S DA=1
|
|---|
| 71 | S DIQ="PPPTMP"
|
|---|
| 72 | S DIQ(0)="I"
|
|---|
| 73 | D EN^DIQ1
|
|---|
| 74 | I $D(PPPTMP) D
|
|---|
| 75 | .S VAL=PPPTMP(1020.3,DA,CODE,"I")
|
|---|
| 76 | .S VAL=VAL+INCRMNT
|
|---|
| 77 | .S DIE="^PPP(1020.3,"
|
|---|
| 78 | .S DR=CODE_"///"_VAL
|
|---|
| 79 | .D ^DIE
|
|---|
| 80 | .I $D(DTOUT) S ERR=FMERR
|
|---|
| 81 | E S ERR=FMERR
|
|---|
| 82 | Q:ERR ERR
|
|---|
| 83 | Q 0
|
|---|
| 84 | ;
|
|---|
| 85 | CLRSTAT ; Set all statistics to 0
|
|---|
| 86 | ;
|
|---|
| 87 | N DA,DIE,DR,ERR,FMERR
|
|---|
| 88 | N DIR,Y
|
|---|
| 89 | ;
|
|---|
| 90 | S FMERR=-9002
|
|---|
| 91 | ;
|
|---|
| 92 | I '$D(^PPP(1020.3)) D Q
|
|---|
| 93 | .W !,"Error... PPP STATISTIC file missing"
|
|---|
| 94 | S DIR(0)="YA"
|
|---|
| 95 | S DIR("A")="Clear entries in PPP STATISTICS file: "
|
|---|
| 96 | S DIR("B")="NO"
|
|---|
| 97 | S DIR("?")="Enter yes to zero out entries in file."
|
|---|
| 98 | D ^DIR
|
|---|
| 99 | I Y D CLR1
|
|---|
| 100 | E W !!,"PPP STATISTICS file unchanged"
|
|---|
| 101 | ;
|
|---|
| 102 | R !,"Press <RETURN> to continue...",PPPX:DTIME K PPPX
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | CLR1 ; -- Clears statistics
|
|---|
| 106 | I $D(^PPP(1020.3,1)) D
|
|---|
| 107 | .S DIK="^PPP(1020.3,"
|
|---|
| 108 | .S DA=1
|
|---|
| 109 | .D ^DIK
|
|---|
| 110 | ;
|
|---|
| 111 | S ERR=0
|
|---|
| 112 | S DIC="^PPP(1020.3,"
|
|---|
| 113 | S X=1
|
|---|
| 114 | S DIC(0)=""
|
|---|
| 115 | S DIC("DR")="1///NOW;2///0;3///0;4///0;5///0;6///0;7///0;8///0;9///0"
|
|---|
| 116 | K DD,DO ; -- required by FILE^DICN call
|
|---|
| 117 | D FILE^DICN
|
|---|
| 118 | I +Y=1 W !!,"All Statistics Set To 0."
|
|---|
| 119 | E W !,"Error... Could not create entry in statistics file."
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | SNDBLTN(MSGSUB,MSGFROM,MSGTXT) ; Send a message
|
|---|
| 123 | ;
|
|---|
| 124 | ; This function will send a message via mailman.
|
|---|
| 125 | ;
|
|---|
| 126 | ; Parameters:
|
|---|
| 127 | ; MSGSUB - The subject of the message.
|
|---|
| 128 | ; MSGFROM - The sender of the message. If this field is
|
|---|
| 129 | ; not defined or NULL, the current DUZ is used.
|
|---|
| 130 | ; MSGTXT - The array name which contains the text
|
|---|
| 131 | ; of the message.
|
|---|
| 132 | ;
|
|---|
| 133 | ; Returns:
|
|---|
| 134 | ; 0 - Normal Termination
|
|---|
| 135 | ; -9001 - Input Parameter Error
|
|---|
| 136 | ;
|
|---|
| 137 | N PARMERR,BULLERR,GRPERR,XMDUZ,XMTEXT,Y,ERR
|
|---|
| 138 | ;
|
|---|
| 139 | S PARMERR=-9001
|
|---|
| 140 | S GRPERR=-9016
|
|---|
| 141 | ;
|
|---|
| 142 | I '$D(MSGSUB) Q PARMERR
|
|---|
| 143 | I MSGSUB="" Q PARMERR
|
|---|
| 144 | S XMSUB=MSGSUB
|
|---|
| 145 | ;
|
|---|
| 146 | I '$D(MSGFROM) S MSGFROM=""
|
|---|
| 147 | I MSGFROM="" S XMDUZ=.5
|
|---|
| 148 | I MSGFROM'="" S XMDUZ=MSGFROM
|
|---|
| 149 | ;
|
|---|
| 150 | I $D(MSGTXT) S XMTEXT=MSGTXT
|
|---|
| 151 | ;
|
|---|
| 152 | S ERR=$$GETMBRS("PRESCRIPTION PRACTICES","XMY")
|
|---|
| 153 | I ERR<1 Q GRPERR
|
|---|
| 154 | ;
|
|---|
| 155 | S XMCHAN=1 ; -- Silents all interactive feed back
|
|---|
| 156 | D ^XMD
|
|---|
| 157 | D KILL^XM
|
|---|
| 158 | K XMCHAN
|
|---|
| 159 | Q 0
|
|---|
| 160 | ;
|
|---|
| 161 | GETMBRS(MAILGRP,ARRAY) ; Get the members of a mail group
|
|---|
| 162 | ;
|
|---|
| 163 | ; Parameters:
|
|---|
| 164 | ; MAILGRP - The name of the group without the 'G.'
|
|---|
| 165 | ; ARRAY - The name of the array where you want the names stored.
|
|---|
| 166 | ;
|
|---|
| 167 | ; Returns:
|
|---|
| 168 | ; The number of members found or a negative error code.
|
|---|
| 169 | ;
|
|---|
| 170 | N PARMERR,GRPERR,MGIFN,MEMBER,TMEMBER
|
|---|
| 171 | ;
|
|---|
| 172 | S PARMERR=-9001
|
|---|
| 173 | S GRPERR=-9016
|
|---|
| 174 | S TMEMBER=0
|
|---|
| 175 | ;
|
|---|
| 176 | I '$D(PARMERR) Q PARMERR
|
|---|
| 177 | I '$D(ARRAY) Q PARMERR
|
|---|
| 178 | I $L(MAILGRP)=""!($L(ARRAY)="") Q PARMERR
|
|---|
| 179 | ;
|
|---|
| 180 | S MGIFN=$O(^XMB(3.8,"B",MAILGRP,"")) Q:MGIFN="" GRPERR
|
|---|
| 181 | ;
|
|---|
| 182 | S MEMBER=""
|
|---|
| 183 | F I=0:0 D Q:MEMBER=""
|
|---|
| 184 | .S MEMBER=$O(^XMB(3.8,MGIFN,1,"B",MEMBER)) Q:MEMBER=""
|
|---|
| 185 | .S @ARRAY@(MEMBER)=""
|
|---|
| 186 | .S TMEMBER=TMEMBER+1
|
|---|
| 187 | Q TMEMBER
|
|---|
