- 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 Mar 13, 2025@21:33:12 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