PSUV0 ;BIR/CFL - Master Routine for PBMS IV Module; 09/09/1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN S PSUJOB=$G(PSUJOB,$J),PSUIVSUB="PSUIV_"_PSUJOB
S X1=PSUSDT,X2=-31
D C^%DTC K %,%H,%T
S PSUIVDT=X
K ^XTMP(PSUIVSUB)
S X1=DT,X2=6 D C^%DTC K %,%H,%T
S ^XTMP(PSUIVSUB,0)=X_U_DT_U_"PSU PBM 'IV' STATISTICAL DATA"
D SECTN^PSUTL1
D ^PSUV1
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D EN^PSUV3(.PSUARM)
;
D PULL^PSUCP
F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
;
I $D(PSUMOD(10)) D IVSSN^PSUDEM4 ;Provider extract
;
;Patient demographics IV summary report
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D
.I '$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) D EN^PSUSUM4
;
K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
;
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D EN^PSUV11
D CLEAN
Q
PRINT ;Print hard copies of summary reports
S PSUIVSUB="PSUIV_"_PSUJOB
D EN^PSUV5
D CLEAN
Q
;
CLEAN ; clean up local symbol table
S XPSUOPTN=PSUOPTN,XPSUJOB=PSUJOB M XPSUMOD=PSUMOD
D VARKILL^PSUTL ; kill all PSU namespace variables
S PSUOPTN=XPSUOPTN,PSUJOB=XPSUJOB M PSUMOD=XPSUMOD K XPSUOPTN,XPSUJOB,XPSUMOD
K ADTIV,COUNT,DASH,DATA,DFN,DIC,DLM,ENDIT,EXTD,GENRIC,I,INDEX,J,LINE,LNCNT,NONE,OCC
K PSBAGS,PSDISP,PSECT,PSIVNFI,PSIVNFR,PSLN,PSNAME,REC,RECIND,RECTYP
K SOLDA,SOLDRUG,SPECPTR,TYPE,VOLUME,X,X1,X2,Y,Z
D PULL^PSUCP,OPTS^PSUCP
K PSUIVA,PSUAMIS,LVP,PB,TPN,CH,SYR,AMIS
CLEANQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV0 1427 printed Oct 16, 2024@18:29:26 Page 2
PSUV0 ;BIR/CFL - Master Routine for PBMS IV Module; 09/09/1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
EN SET PSUJOB=$GET(PSUJOB,$JOB)
SET PSUIVSUB="PSUIV_"_PSUJOB
+1 SET X1=PSUSDT
SET X2=-31
+2 DO C^%DTC
KILL %,%H,%T
+3 SET PSUIVDT=X
+4 KILL ^XTMP(PSUIVSUB)
+5 SET X1=DT
SET X2=6
DO C^%DTC
KILL %,%H,%T
+6 SET ^XTMP(PSUIVSUB,0)=X_U_DT_U_"PSU PBM 'IV' STATISTICAL DATA"
+7 DO SECTN^PSUTL1
+8 DO ^PSUV1
+9 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
DO EN^PSUV3(.PSUARM)
+10 ;
+11 DO PULL^PSUCP
+12 FOR I=1:1:$LENGTH(PSUOPTS,",")
SET PSUMOD($PIECE(PSUOPTS,",",I))=""
+13 ;
+14 ;Provider extract
IF $DATA(PSUMOD(10))
DO IVSSN^PSUDEM4
+15 ;
+16 ;Patient demographics IV summary report
+17 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
Begin DoDot:1
+18 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMFLAG"))
DO EN^PSUSUM4
End DoDot:1
+19 ;
+20 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
+21 ;
+22 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
DO EN^PSUV11
+23 DO CLEAN
+24 QUIT
PRINT ;Print hard copies of summary reports
+1 SET PSUIVSUB="PSUIV_"_PSUJOB
+2 DO EN^PSUV5
+3 DO CLEAN
+4 QUIT
+5 ;
CLEAN ; clean up local symbol table
+1 SET XPSUOPTN=PSUOPTN
SET XPSUJOB=PSUJOB
MERGE XPSUMOD=PSUMOD
+2 ; kill all PSU namespace variables
DO VARKILL^PSUTL
+3 SET PSUOPTN=XPSUOPTN
SET PSUJOB=XPSUJOB
MERGE PSUMOD=XPSUMOD
KILL XPSUOPTN,XPSUJOB,XPSUMOD
+4 KILL ADTIV,COUNT,DASH,DATA,DFN,DIC,DLM,ENDIT,EXTD,GENRIC,I,INDEX,J,LINE,LNCNT,NONE,OCC
+5 KILL PSBAGS,PSDISP,PSECT,PSIVNFI,PSIVNFR,PSLN,PSNAME,REC,RECIND,RECTYP
+6 KILL SOLDA,SOLDRUG,SPECPTR,TYPE,VOLUME,X,X1,X2,Y,Z
+7 DO PULL^PSUCP
DO OPTS^PSUCP
+8 KILL PSUIVA,PSUAMIS,LVP,PB,TPN,CH,SYR,AMIS
CLEANQ QUIT
