PSUAR0.m

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 ---PSUAR0   1793     printed  Apr 09, 2024@21:30:23                                                                                                                                                                                                      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