- 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 Mar 13, 2025@21:38:47 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 ;
