PSS1P126 ;SMT - PSS*1*126 POST INSTALL ; 8/21/07 10:48am
;;1.0; PHARMACY DATA MANAGEMENT;**126**; 4/26/07;Build 11
;
;This routine will send mail to anyone holding the "PSNMGR" key
; as well as the installing user, a list of drugs whos DEA code
; is subject to change as the result of PSS*1*126 and PSO*7*206
; DEA code changes.
;
EN N XMDUZ,XMSUB,XMTEXT,DIFROM,XMY,X,CNT,OP,SPC,Y,VAR
S X=0,CNT=8
F S X=$O(^PSDRUG(X)) Q:'X I $G(^PSDRUG(X,0))]"",($P(^PSDRUG(X,0),"^",3)["3A")!($P(^PSDRUG(X,0),"^",3)["4A")!($P(^PSDRUG(X,0),"^",3)["5A") D S CNT=CNT+1
.S SPC(0)=X,SPC(10)=$P(^PSDRUG(X,0),"^")
.S (Y,VAR)="" F S Y=$O(SPC(Y)) Q:Y="" F Q:$L($G(VAR))>Y S:$L($G(VAR))<Y VAR=VAR_" " S:$L(VAR)=Y VAR=VAR_SPC(Y)
.S OP(CNT)=VAR
S OP(1)="This is an alert containing drugs with DEA schedules that are going to change."
S OP(2)="The following drugs should be reviewed by pharmacy and verified "
S OP(3)="that they contain the correct scheduling after the changes. Please "
S OP(4)="see the patch description for a corresponding table and decide what "
S OP(5)="the new codes should be."
S OP(6)="There are a total of "_(CNT-8)_" drug(s) that have changed."
S OP(7)="IEN NAME"
S XMDUZ="POSTMASTER",XMSUB="DEA CODES SUBJECT TO CHANGE PLEASE REVIEW",XMTEXT="OP("
S XMY(DUZ)=""
S X="" F S X=$O(^XUSEC("PSNMGR",X)) Q:'X S XMY(X)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS1P126 1386 printed Dec 13, 2024@02:29:21 Page 2
PSS1P126 ;SMT - PSS*1*126 POST INSTALL ; 8/21/07 10:48am
+1 ;;1.0; PHARMACY DATA MANAGEMENT;**126**; 4/26/07;Build 11
+2 ;
+3 ;This routine will send mail to anyone holding the "PSNMGR" key
+4 ; as well as the installing user, a list of drugs whos DEA code
+5 ; is subject to change as the result of PSS*1*126 and PSO*7*206
+6 ; DEA code changes.
+7 ;
EN NEW XMDUZ,XMSUB,XMTEXT,DIFROM,XMY,X,CNT,OP,SPC,Y,VAR
+1 SET X=0
SET CNT=8
+2 FOR
SET X=$ORDER(^PSDRUG(X))
if 'X
QUIT
IF $GET(^PSDRUG(X,0))]""
IF ($PIECE(^PSDRUG(X,0),"^",3)["3A")!($PIECE(^PSDRUG(X,0),"^",3)["4A")!($PIECE(^PSDRUG(X,0),"^",3)["5A")
Begin DoDot:1
+3 SET SPC(0)=X
SET SPC(10)=$PIECE(^PSDRUG(X,0),"^")
+4 SET (Y,VAR)=""
FOR
SET Y=$ORDER(SPC(Y))
if Y=""
QUIT
FOR
if $LENGTH($GET(VAR))>Y
QUIT
if $LENGTH($GET(VAR))<Y
SET VAR=VAR_" "
if $LENGTH(VAR)=Y
SET VAR=VAR_SPC(Y)
+5 SET OP(CNT)=VAR
End DoDot:1
SET CNT=CNT+1
+6 SET OP(1)="This is an alert containing drugs with DEA schedules that are going to change."
+7 SET OP(2)="The following drugs should be reviewed by pharmacy and verified "
+8 SET OP(3)="that they contain the correct scheduling after the changes. Please "
+9 SET OP(4)="see the patch description for a corresponding table and decide what "
+10 SET OP(5)="the new codes should be."
+11 SET OP(6)="There are a total of "_(CNT-8)_" drug(s) that have changed."
+12 SET OP(7)="IEN NAME"
+13 SET XMDUZ="POSTMASTER"
SET XMSUB="DEA CODES SUBJECT TO CHANGE PLEASE REVIEW"
SET XMTEXT="OP("
+14 SET XMY(DUZ)=""
+15 SET X=""
FOR
SET X=$ORDER(^XUSEC("PSNMGR",X))
if 'X
QUIT
SET XMY(X)=""
+16 DO ^XMD
+17 QUIT
