Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUPR0

PSUPR0.m

Go to the documentation of this file.
  1. PSUPR0 ;BIR/PDW - PROCUREMENT EXTRACT ENTRY ROUTINE ;25 AUG 1998
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA's
  1. ; Reference to file 4.3 supported by DBIA 10091
  1. ; Reference to file 4 supported by DBIA 10090
  1. ;
  1. EN ;EP from PSUCP
  1. ;
  1. ; pull variables from ^XTMP
  1. ; PSUJOB must exist and must be the job number used to store the data desired for this session.
  1. I '$D(PSUJOB) S PSUJOB=$J
  1. S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
  1. F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
  1. PULLQ ;Q
  1. S PSUPRJOB=PSUJOB
  1. S PSUPRSUB="PSUPR_"_PSUPRJOB
  1. ; Setup ^XTMP
  1. S X1=DT,X2=6 D C^%DTC
  1. K ^XTMP(PSUPRSUB)
  1. S ^XTMP(PSUPRSUB,0)=X_U_DT_"^ PBM Extract - Procurement Module "
  1. ;
  1. ; Store Important variables
  1. K X
  1. S X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSUPRSUB,PSUJOB,PSURTN,PSUOPTN"
  1. F I=1:1 S Y=$P(X,",",I) Q:Y="" I $D(@Y) S X(Y)=@Y
  1. M ^XTMP(PSUPRSUB,"SAVE")=X
  1. K X
  1. ; Process the Procurement Files
  1. ; Code for CoreFLS * NOTE: This will be commented out as of 7/1/04
  1. ;until such time as CoreFLS code is released.
  1. ;S X="PSAFLS" X ^%ZOSF("TEST")
  1. ;I $T D
  1. ;.S PSUPRSUB="PSUPR_"_$J
  1. ;.S PSUFLSFG="" ;FLAG TO SIGNAL COREFLS IN EFFECT
  1. ;.D EN^PSUPR2
  1. ;.D EN^PSUPR3
  1. ;.K PSUFLSFG
  1. ;I '$T D ;CoreFLS code. Commented out. When CoreFLS code is
  1. ;released put the next 3 lines inside a dot structure.
  1. D EN^PSUPR1 ; file 442
  1. D EN^PSUPR2 ; file 58.811
  1. D EN^PSUPR3 ; file 58.81
  1. K PSUMSG
  1. D EN^PSUPR4(.PSUMSG) ; detailed mail message to Hines
  1. D EN^PSUPR5 ;Summary Mail Routines
  1. ;
  1. ; return counters to master routine
  1. S PSUSUB="PSU_"_PSUJOB
  1. I $D(^XTMP(PSUSUB)),PSUDUZ,PSUPBMG M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
  1. ;D EN^PSUPR5 ; Summary Mail Routines
  1. Q
  1. PRINT ;EP Tasking Entry Point for PRINT REPORT
  1. D EN^PSUPR6
  1. Q
  1. EXIT ;EP Tasking Entry Point for Cleaning out XTMP and Variables
  1. ; Restore Important Variables
  1. K X
  1. M X=^XTMP(PSUPRSUB,"SAVE")
  1. K ^XTMP(PSUPRSUB)
  1. D VARKILL^PSUTL
  1. ; Restore Important Variables CONTINUED
  1. S Y="" F S Y=$O(X(Y)) Q:Y="" S @Y=X(Y)
  1. K X
  1. Q
  1. ;
  1. CLEAR ;EP clear ^XTMP of PSUPR nodes
  1. S X="PSUPR"
  1. F S X=$O(^XTMP(X)) Q:X="" Q:$E(X,1,5)'="PSUPR" W !,X K ^XTMP(X)
  1. Q
  1. MANUAL ;EP Manual entry point for Running Procurement Module to
  1. ; exercise detailed message, summary messages, & Reports
  1. ; Some startup code borrowed from PSUCP for dates
  1. W !,"Mail messages are sent to the user only at this time",!
  1. S PSUMON=$E(DT,1,5),(PSUSMRY,PSUMASF,PSUPBMG)=1,PSUDUZ=DUZ
  1. S X=$P($G(^XMB(1,1,"XUS")),U,17),PSUSNDR=+$P(^DIC(4,X,99),U)
  1. K %DT
  1. S %DT="AEX",%DT(0)="-NOW",%DT("A")="STARTING Procurement Extract Date or ""^"" to quit : " D ^%DT
  1. I X["^" Q
  1. I 'Y Q
  1. S PSUSDT=+Y
  1. K %DT W !
  1. S %DT="AEX",%DT(0)=PSUSDT,%DT("A")="ENDING Procurement Extract Date or ""^"" to restart: " D ^%DT
  1. I X["^" G MANUAL
  1. I 'Y G MANUAL
  1. S PSUEDT=+Y
  1. W !
  1. S Y=PSUSDT D DD^%DT W !,"Starting Procurement Date",?30,Y
  1. S Y=PSUEDT D DD^%DT W !,"Ending Procurement Date:",?30,Y
  1. K DIR W !
  1. S DIR(0)="Y",DIR("A")="Correct ? ",DIR("B")="YES" D ^DIR
  1. I 'Y G MANUAL
  1. K DIR W !
  1. W !,"You can not queue to your terminal",!
  1. W !,"You can queue to a host file",!
  1. S DIR(0)="Y",DIR("A")="Do yo want reports printed ? ",DIR("B")="YES" D ^DIR
  1. K DIR W !
  1. S PSURP=+Y
  1. S PSURC="COMPUTE^PSUPR0"
  1. I PSURP S PSURP="PRINT^PSUPR0" K PSUIOP
  1. E K PSURP S PSUIOP="" ; MAIL MESSAGES ONLY
  1. S PSURX="EXIT^PSUPR0"
  1. S PSUNS="PSUPR*,PSUSDT,PSUEDT,PSU*"
  1. D EN^PSUDBQUE
  1. Q