- 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 Feb 18, 2025@23:55:23 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
