- PSO653P ;BIRM/KML - PHARMACY TELEPHONE REFILL ; 12/26/17 12:13pm
- ;;7.0;OUTPATIENT PHARMACY;**653**;Dec 1997;Build 14
- ; --------------------------------------------------------------------------------------
- ; 1. TASK - schedules the new PSO PURGE PROCESSED 52.444 option
- ; 2. MENU - adds the new option, Process Telephone Refills [PSO PROCESS TELEPHONE REFILLS] to the existing Barcode Rx Menu [BARCODE RX MENU]
- N TEXT D TASK,MENU
- ; disable the class 3 option A3A PHONE REFILLS by adding an out-of-order message to the entry in the OPTION file
- D OUT^XPDMENU("A3A PHONE REFILLS","Replaced by Class 1 Option [PSO PROCESS TELEPHONE REFILLS]")
- S TEXT(1)="Process Telephone Refills [A3A PHONE REFILLS] option"
- S TEXT(2)="has been placed OUT-OF-ORDER"
- S TEXT(3)="****************************"
- S TEXT(4)=""
- D MES^XPDUTL(.TEXT)
- Q
- TASK ; schedule the new purge option
- N PSOAOPTB,PSOAOPTN,DA,DIE,DR,X,X1,X2,PSOWHEN,PSOSD
- S X1=DT,X2=+1 D C^%DTC S PSOSD=X
- S PSOWHEN=PSOSD_"@0405" ;PSOPURGE DATE TIME.
- D RESCH^XUTMOPT("PSO PURGE PROCESSED 52.444",PSOWHEN,"","1D","L",".PSOA_ERROR")
- S TEXT(1)="Purge Processed Telephone Refill Requests [PSO PURGE PROCESSED 52.444] option"
- S TEXT(2)="has been scheduled to occur at 4:05 am every day."
- S TEXT(3)="****************************"
- S TEXT(4)=""
- D MES^XPDUTL(.TEXT)
- Q
- ;PSO BARCODE MENU class 1 MENU
- ;PSO PROCESS TELEPHONE REFILLS
- N FDA,PSOCOP,PSOCIEN,PSOCOPNM,PSOCSYN
- S PSOCOP=$O(^DIC(19,"B","PSO BARCODE MENU",0))
- S PSOCOPNM="PSO PROCESS TELEPHONE REFILLS"
- S PSOCIEN=0 S PSOCIEN=$O(^DIC(19,"B",PSOCOPNM,0))
- S PSOCSYN="PTR"
- S TEXT(1)="Process Telephone Refills [PSO PROCESS TELEPHONE REFILLS] option"
- S TEXT(2)="has been added to the existing Barcode Rx Menu [PSO BARCODE MENU]"
- S TEXT(3)="****************************"
- S TEXT(4)=""
- D MES^XPDUTL(.TEXT)
- Q:$D(^DIC(19,PSOCOP,10,"B",PSOCIEN))
- S FDA(1,19.01,"+2,"_PSOCOP_",",.01)=PSOCIEN
- S FDA(1,19.01,"+2,"_PSOCOP_",",2)=PSOCSYN
- D UPDATE^DIE("","FDA(1)")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO653P 2048 printed Feb 18, 2025@23:49:47 Page 2
- PSO653P ;BIRM/KML - PHARMACY TELEPHONE REFILL ; 12/26/17 12:13pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**653**;Dec 1997;Build 14
- +2 ; --------------------------------------------------------------------------------------
- +3 ; 1. TASK - schedules the new PSO PURGE PROCESSED 52.444 option
- +4 ; 2. MENU - adds the new option, Process Telephone Refills [PSO PROCESS TELEPHONE REFILLS] to the existing Barcode Rx Menu [BARCODE RX MENU]
- +5 NEW TEXT
- DO TASK
- DO MENU
- +6 ; disable the class 3 option A3A PHONE REFILLS by adding an out-of-order message to the entry in the OPTION file
- +7 DO OUT^XPDMENU("A3A PHONE REFILLS","Replaced by Class 1 Option [PSO PROCESS TELEPHONE REFILLS]")
- +8 SET TEXT(1)="Process Telephone Refills [A3A PHONE REFILLS] option"
- +9 SET TEXT(2)="has been placed OUT-OF-ORDER"
- +10 SET TEXT(3)="****************************"
- +11 SET TEXT(4)=""
- +12 DO MES^XPDUTL(.TEXT)
- +13 QUIT
- TASK ; schedule the new purge option
- +1 NEW PSOAOPTB,PSOAOPTN,DA,DIE,DR,X,X1,X2,PSOWHEN,PSOSD
- +2 SET X1=DT
- SET X2=+1
- DO C^%DTC
- SET PSOSD=X
- +3 ;PSOPURGE DATE TIME.
- SET PSOWHEN=PSOSD_"@0405"
- +4 DO RESCH^XUTMOPT("PSO PURGE PROCESSED 52.444",PSOWHEN,"","1D","L",".PSOA_ERROR")
- +5 SET TEXT(1)="Purge Processed Telephone Refill Requests [PSO PURGE PROCESSED 52.444] option"
- +6 SET TEXT(2)="has been scheduled to occur at 4:05 am every day."
- +7 SET TEXT(3)="****************************"
- +8 SET TEXT(4)=""
- +9 DO MES^XPDUTL(.TEXT)
- +10 QUIT
- +1 ;PSO BARCODE MENU class 1 MENU
- +2 ;PSO PROCESS TELEPHONE REFILLS
- +3 NEW FDA,PSOCOP,PSOCIEN,PSOCOPNM,PSOCSYN
- +4 SET PSOCOP=$ORDER(^DIC(19,"B","PSO BARCODE MENU",0))
- +5 SET PSOCOPNM="PSO PROCESS TELEPHONE REFILLS"
- +6 SET PSOCIEN=0
- SET PSOCIEN=$ORDER(^DIC(19,"B",PSOCOPNM,0))
- +7 SET PSOCSYN="PTR"
- +8 SET TEXT(1)="Process Telephone Refills [PSO PROCESS TELEPHONE REFILLS] option"
- +9 SET TEXT(2)="has been added to the existing Barcode Rx Menu [PSO BARCODE MENU]"
- +10 SET TEXT(3)="****************************"
- +11 SET TEXT(4)=""
- +12 DO MES^XPDUTL(.TEXT)
- +13 if $DATA(^DIC(19,PSOCOP,10,"B",PSOCIEN))
- QUIT
- +14 SET FDA(1,19.01,"+2,"_PSOCOP_",",.01)=PSOCIEN
- +15 SET FDA(1,19.01,"+2,"_PSOCOP_",",2)=PSOCSYN
- +16 DO UPDATE^DIE("","FDA(1)")
- +17 QUIT