PSO653P.m

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

MENU ;add new class 1 option

 ;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 ---PSO653P   2048     printed  Apr 09, 2024@21:33:16                                                                                                                                                                                                     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 

MENU      ;add new class 1 option

 +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