PSUAR0 ; BIR/PDW - Master Routine for AR/WS PBMS Extraction ;25 AUG 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN ; EP ENTRY FROM PSUCP
PULL ; pull variables from ^XTMP
;PSUJOB must exist and must be the job number used to store the data desired for this session.
I '$D(PSUJOB) S PSUJOB=$J
S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
;
I '$D(PSUJOB) S PSUJOB=$J
S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
COMPUTE ;EP for Compute Cycle of AR/WS Extract
S PSUARJOB=PSUJOB
S PSUARSUB="PSUAR_"_PSUARJOB
K ^XTMP(PSUARSUB)
S X1=DT,X2=6 D C^%DTC
S ^XTMP(PSUARSUB,0)=X_U_DT_"^ Storage for PBMS AR/WS Extract Data"
;
; Save Important Variables
S X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSUPRSUB,PSUPRJOB,PSUJOB,PSUOPTN,PSURTN"
F I=1:1 S Y=$P(X,",",I) Q:Y="" I $D(@Y) S X(Y)=@Y
M ^XTMP(PSUARSUB,"SAVE")=X
;
D EN^PSUAR1 ; Gather Data
D EN^PSUAR2 ; Build Records from Data
D EN^PSUAR3(.PSUARM) ; Mail Message Generator
S PSUSUB="PSU_"_PSUJOB
I $D(^XTMP(PSUSUB)),PSUMASF M ^XTMP(PSUSUB,"CONFIRM")=PSUARM
I $D(^XTMP(PSUSUB)),PSUPBMG M ^XTMP(PSUSUB,"CONFIRM")=PSUARM
D EN^PSUAR4 ; Summary Messages
D EN^PSUAR6 ; AMIST Summary report
K PSUAR,PSUAMIS,AMISAR
Q
;
PRINT ;EP for Print Cycle
D EN^PSUAR5
Q
EXIT ;EP for Cleaning up & Restoring variables
M Z=^XTMP(PSUARSUB,"SAVE")
K ^XTMP(PSUARJOB)
; Kill PSU Variables
D VARKILL^PSUTL
; Restore Important Variables
S Y="" F S Y=$O(Z(Y)) Q:Y="" S @Y=Z(Y)
K Z
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUAR0 1793 printed Sep 23, 2025@20:02:59 Page 2
PSUAR0 ; BIR/PDW - Master Routine for AR/WS PBMS Extraction ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN ; EP ENTRY FROM PSUCP
PULL ; pull variables from ^XTMP
+1 ;PSUJOB must exist and must be the job number used to store the data desired for this session.
+2 IF '$DATA(PSUJOB)
SET PSUJOB=$JOB
+3 SET PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
+4 FOR I=1:1:$LENGTH(PSUVARS,",")
SET @$PIECE(PSUVARS,",",I)=$PIECE(^XTMP("PSU_"_PSUJOB,1),U,I)
+5 ;
+6 IF '$DATA(PSUJOB)
SET PSUJOB=$JOB
+7 SET PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
+8 FOR I=1:1:$LENGTH(PSUVARS,",")
SET @$PIECE(PSUVARS,",",I)=$PIECE(^XTMP("PSU_"_PSUJOB,1),U,I)
COMPUTE ;EP for Compute Cycle of AR/WS Extract
+1 SET PSUARJOB=PSUJOB
+2 SET PSUARSUB="PSUAR_"_PSUARJOB
+3 KILL ^XTMP(PSUARSUB)
+4 SET X1=DT
SET X2=6
DO C^%DTC
+5 SET ^XTMP(PSUARSUB,0)=X_U_DT_"^ Storage for PBMS AR/WS Extract Data"
+6 ;
+7 ; Save Important Variables
+8 SET X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSUPRSUB,PSUPRJOB,PSUJOB,PSUOPTN,PSURTN"
+9 FOR I=1:1
SET Y=$PIECE(X,",",I)
if Y=""
QUIT
IF $DATA(@Y)
SET X(Y)=@Y
+10 MERGE ^XTMP(PSUARSUB,"SAVE")=X
+11 ;
+12 ; Gather Data
DO EN^PSUAR1
+13 ; Build Records from Data
DO EN^PSUAR2
+14 ; Mail Message Generator
DO EN^PSUAR3(.PSUARM)
+15 SET PSUSUB="PSU_"_PSUJOB
+16 IF $DATA(^XTMP(PSUSUB))
IF PSUMASF
MERGE ^XTMP(PSUSUB,"CONFIRM")=PSUARM
+17 IF $DATA(^XTMP(PSUSUB))
IF PSUPBMG
MERGE ^XTMP(PSUSUB,"CONFIRM")=PSUARM
+18 ; Summary Messages
DO EN^PSUAR4
+19 ; AMIST Summary report
DO EN^PSUAR6
+20 KILL PSUAR,PSUAMIS,AMISAR
+21 QUIT
+22 ;
PRINT ;EP for Print Cycle
+1 DO EN^PSUAR5
+2 QUIT
EXIT ;EP for Cleaning up & Restoring variables
+1 MERGE Z=^XTMP(PSUARSUB,"SAVE")
+2 KILL ^XTMP(PSUARJOB)
+3 ; Kill PSU Variables
+4 DO VARKILL^PSUTL
+5 ; Restore Important Variables
+6 SET Y=""
FOR
SET Y=$ORDER(Z(Y))
if Y=""
QUIT
SET @Y=Z(Y)
+7 KILL Z
+8 QUIT
