PSSPRICE ;EPIP/WC - PHARMACY PRICE TRACKER FILE 50;1/13/20 3:31pm
;;1.0;PHARMACY DATA MANAGEMENT;**227,236,241**;2/28/17;Build 2
Q ; call by line tag
; UDPATE^DIE supported by ICR #2053
; ^XMD supported by ICR #10113
ST(PSSIEN,PSSDUZ,PSSFLD) ;
; PSSIEN=DRUG IEN
; PSSNEW=NEW PRICE
; PSSDUZ=USER CHANGING PRICE
; PSSFLD=13-PRICE PER ORDER UNIT, 15-DISPENSE UNITS PER ORDER UNIT ;p236
; CLASS 3 CROSS REFER ON FILE 50 FIELD #16
N DA,DIE,X,Y,DIC
N PSSNEW
;LEAST GET THE TIME THE CHANGE WAS MADE
D NOW^%DTC S PSSTIME=%
S PSSNEW=$P($G(^PSDRUG(PSSIEN,660)),"^",6)
;
QUE ;ENTER THE DATA IN FILE 50 MULTIPLE FIELD 950
S ZTRTN="HIS^PSSPRICE"
S ZTDESC="PHARMACY PRICE TRACKER "
S ZTSAVE("PSSIEN")=""
S ZTSAVE("PSSNEW")=""
S ZTSAVE("PSSDUZ")=""
S ZTSAVE("PSSTIME")=""
S ZTSAVE("PSSFLD")=""
S ZTIO=""
D NOW^%DTC S ZTDTH=%
D ^%ZTLOAD
D HOME^%ZIS
Q
HIS ;LOGS CHANGES IN FILE 50 HISTORY PRICE DISPENSE #950
; first delete any price updates prior to the retention limit set up in the paramater PSS DRUG AUDIT RETENTION MOS
N DEFDT,PSIEN2 S DEFDT=+$$GET^XPAR("ALL","PSS DRUG AUDIT RETENTION MOS")
S DEFMOS=$S(DEFDT>0:DEFDT,1:999999999)
S X1=$$NOW^XLFDT,X2=DEFMOS*30 D C^%DTC S ENDDT=X
S X1=$P($$NOW^XLFDT,".",1)
S ENDDT=$$FMADD^XLFDT(DT,"-"_(DEFMOS*30))
I $O(^PSDRUG(PSSIEN,950,0)) D
. F S PSIEN2=$O(^PSDRUG(PSSIEN,950,0)) Q:'PSIEN2 Q:^(PSIEN2,0)>ENDDT D ;p236
. . N DIK,DA
. . S DIK="^PSDRUG(PSSIEN,950,",DA(1)=PSSIEN,DA=PSIEN2 D ^DIK ; Delete old data
N PSSPDU S PSSPDU=99999,PSSPDU=$O(^PSDRUG(PSSIEN,950,PSSPDU),-1) ; p236
I PSSPDU>0,PSSNEW=$P($G(^PSDRUG(PSSIEN,950,PSSPDU,0)),"^",3) Q ; p236 Quit if no changes to PRICE PER DISPENSE UNIT
N FDA
S FDA(50.095,"?+1,"_PSSIEN_",",.01)=PSSTIME
S FDA(50.095,"?+1,"_PSSIEN_",",1)=PSSDUZ
S FDA(50.095,"?+1,"_PSSIEN_",",3)=PSSNEW
D UPDATE^DIE("","FDA")
S PSSNAME=$$GET1^DIQ(200,PSSDUZ_",",.01)
BULL ;Generate the bulletin.
S XMY("G.PSS DEE AUDIT")=""
S XMSUB="Pharmacy Price Tracker",XMDUZ=.5
S ^UTILITY($J,"PHARM TRACK",1)=PSSNAME_" has changed the "_$S(PSSFLD=13:"PRICE PER ORDER UNIT",1:"DISPENSE UNITS PER ORDER UNIT") ;p236
S ^UTILITY($J,"PHARM TRACK",2)="The PRICE PER DISPENSE UNIT of:"
S ^UTILITY($J,"PHARM TRACK",3)=$P($G(^PSDRUG(PSSIEN,0)),"^",1)_" is: "_PSSNEW
S ^UTILITY($J,"PHARM TRACK",4)="" ;p236
S ^UTILITY($J,"PHARM TRACK",5)="Date/Time changed: "_$$FMTE^XLFDT(PSSTIME) ;p236
S XMTEXT="^UTILITY($J,""PHARM TRACK""," D ^XMD
K %,PSSTIME,PSSIEN,PSSNAME,PSSOLD,PSSNEW,PSSDUZ,PSSFLD,^UTILITY($J),XMSUB,XMTEXT,XMDUZ
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPRICE 2589 printed Nov 22, 2024@17:44:13 Page 2
PSSPRICE ;EPIP/WC - PHARMACY PRICE TRACKER FILE 50;1/13/20 3:31pm
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**227,236,241**;2/28/17;Build 2
+2 ; call by line tag
QUIT
+3 ; UDPATE^DIE supported by ICR #2053
+4 ; ^XMD supported by ICR #10113
ST(PSSIEN,PSSDUZ,PSSFLD) ;
+1 ; PSSIEN=DRUG IEN
+2 ; PSSNEW=NEW PRICE
+3 ; PSSDUZ=USER CHANGING PRICE
+4 ; PSSFLD=13-PRICE PER ORDER UNIT, 15-DISPENSE UNITS PER ORDER UNIT ;p236
+5 ; CLASS 3 CROSS REFER ON FILE 50 FIELD #16
+6 NEW DA,DIE,X,Y,DIC
+7 NEW PSSNEW
+8 ;LEAST GET THE TIME THE CHANGE WAS MADE
+9 DO NOW^%DTC
SET PSSTIME=%
+10 SET PSSNEW=$PIECE($GET(^PSDRUG(PSSIEN,660)),"^",6)
+11 ;
QUE ;ENTER THE DATA IN FILE 50 MULTIPLE FIELD 950
+1 SET ZTRTN="HIS^PSSPRICE"
+2 SET ZTDESC="PHARMACY PRICE TRACKER "
+3 SET ZTSAVE("PSSIEN")=""
+4 SET ZTSAVE("PSSNEW")=""
+5 SET ZTSAVE("PSSDUZ")=""
+6 SET ZTSAVE("PSSTIME")=""
+7 SET ZTSAVE("PSSFLD")=""
+8 SET ZTIO=""
+9 DO NOW^%DTC
SET ZTDTH=%
+10 DO ^%ZTLOAD
+11 DO HOME^%ZIS
+12 QUIT
HIS ;LOGS CHANGES IN FILE 50 HISTORY PRICE DISPENSE #950
+1 ; first delete any price updates prior to the retention limit set up in the paramater PSS DRUG AUDIT RETENTION MOS
+2 NEW DEFDT,PSIEN2
SET DEFDT=+$$GET^XPAR("ALL","PSS DRUG AUDIT RETENTION MOS")
+3 SET DEFMOS=$SELECT(DEFDT>0:DEFDT,1:999999999)
+4 SET X1=$$NOW^XLFDT
SET X2=DEFMOS*30
DO C^%DTC
SET ENDDT=X
+5 SET X1=$PIECE($$NOW^XLFDT,".",1)
+6 SET ENDDT=$$FMADD^XLFDT(DT,"-"_(DEFMOS*30))
+7 IF $ORDER(^PSDRUG(PSSIEN,950,0))
Begin DoDot:1
+8 ;p236
FOR
SET PSIEN2=$ORDER(^PSDRUG(PSSIEN,950,0))
if 'PSIEN2
QUIT
if ^(PSIEN2,0)>ENDDT
QUIT
Begin DoDot:2
+9 NEW DIK,DA
+10 ; Delete old data
SET DIK="^PSDRUG(PSSIEN,950,"
SET DA(1)=PSSIEN
SET DA=PSIEN2
DO ^DIK
End DoDot:2
End DoDot:1
+11 ; p236
NEW PSSPDU
SET PSSPDU=99999
SET PSSPDU=$ORDER(^PSDRUG(PSSIEN,950,PSSPDU),-1)
+12 ; p236 Quit if no changes to PRICE PER DISPENSE UNIT
IF PSSPDU>0
IF PSSNEW=$PIECE($GET(^PSDRUG(PSSIEN,950,PSSPDU,0)),"^",3)
QUIT
+13 NEW FDA
+14 SET FDA(50.095,"?+1,"_PSSIEN_",",.01)=PSSTIME
+15 SET FDA(50.095,"?+1,"_PSSIEN_",",1)=PSSDUZ
+16 SET FDA(50.095,"?+1,"_PSSIEN_",",3)=PSSNEW
+17 DO UPDATE^DIE("","FDA")
+18 SET PSSNAME=$$GET1^DIQ(200,PSSDUZ_",",.01)
BULL ;Generate the bulletin.
+1 SET XMY("G.PSS DEE AUDIT")=""
+2 SET XMSUB="Pharmacy Price Tracker"
SET XMDUZ=.5
+3 ;p236
SET ^UTILITY($JOB,"PHARM TRACK",1)=PSSNAME_" has changed the "_$SELECT(PSSFLD=13:"PRICE PER ORDER UNIT",1:"DISPENSE UNITS PER ORDER UNIT")
+4 SET ^UTILITY($JOB,"PHARM TRACK",2)="The PRICE PER DISPENSE UNIT of:"
+5 SET ^UTILITY($JOB,"PHARM TRACK",3)=$PIECE($GET(^PSDRUG(PSSIEN,0)),"^",1)_" is: "_PSSNEW
+6 ;p236
SET ^UTILITY($JOB,"PHARM TRACK",4)=""
+7 ;p236
SET ^UTILITY($JOB,"PHARM TRACK",5)="Date/Time changed: "_$$FMTE^XLFDT(PSSTIME)
+8 SET XMTEXT="^UTILITY($J,""PHARM TRACK"","
DO ^XMD
+9 KILL %,PSSTIME,PSSIEN,PSSNAME,PSSOLD,PSSNEW,PSSDUZ,PSSFLD,^UTILITY($JOB),XMSUB,XMTEXT,XMDUZ
+10 QUIT
+11 ;
