PSUOP0 ;BIR/CFL,TJH;PSU PBM Outpatient Pharmacy entry routine;08/25/1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
Q
;
EN ;Entry Point
S PSUOPSUB="PSUOP_"_PSUJOB
K ^XTMP(PSUOPSUB)
S X1=DT,X2=6 D C^%DTC
S ^XTMP(PSUOPSUB,0)=X_U_DT_U_"OUTPATIENT PHARMACY DATA COLLECTION"
S PSUOPVER=$$VERSION^XPDUTL("PSO") ;outpatient software version
S PSUDFVER=$$VERSION^XPDUTL("PSN") ;drug file version
D SECTN^PSUTL1 ;set up section:abbreviation array
;
;VERSION 6.0 software
I +PSUOPVER="6" D ^PSUOP1
;
;VERSION 7.0 software
I +PSUOPVER'<7 D ^PSUOP2
;
;Mail Man Call
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D
.D EN^PSUOP4 ;Single dose messages
.D EN^PSUOPMD ;Multidose messages
;
I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG"))=1 D
.S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11"
.S PSUAUTO=1
;
D PULL^PSUCP
F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
I $D(PSUMOD(10)) D OPSSN^PSUDEM4 ;Provider extract
;
;Rx summary report
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D
.I '$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) D EN^PSUSUM2
.;
.;IV/UD/RX summary report
.I $D(PSUMOD(2))&$D(PSUMOD(1))&$D(PSUMOD(4)) D
..D EN^PSUSUM6
.;
.;IV/RX summary report
.I $D(PSUMOD(1))&'$D(PSUMOD(2))&$D(PSUMOD(4)) D
..D EN^PSUSUM7
.;
.;UD/RX summary report
.I '$D(PSUMOD(1))&$D(PSUMOD(2))&$D(PSUMOD(4)) D
..D EN^PSUSUM7
;
D EN^PSUOP8 ;AMIS SUMMARY REPORT
;
K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
;
D CLEAN
Q
;
PRINT ;Call print routine
;
D ^PSUOP6
;
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 DATA,DFN,PSUDFVER,ENDIT,EXTD,J,NODATA,NONE,PSUOPVER,PSECT,PSOPNFI,PSOPNFR,REC,REC1,REC2,X1,X2,Y,Z,AMIS
D PULL^PSUCP,OPTS^PSUCP
CLEANQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOP0 1899 printed Dec 13, 2024@02:28:06 Page 2
PSUOP0 ;BIR/CFL,TJH;PSU PBM Outpatient Pharmacy entry routine;08/25/1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 QUIT
+4 ;
EN ;Entry Point
+1 SET PSUOPSUB="PSUOP_"_PSUJOB
+2 KILL ^XTMP(PSUOPSUB)
+3 SET X1=DT
SET X2=6
DO C^%DTC
+4 SET ^XTMP(PSUOPSUB,0)=X_U_DT_U_"OUTPATIENT PHARMACY DATA COLLECTION"
+5 ;outpatient software version
SET PSUOPVER=$$VERSION^XPDUTL("PSO")
+6 ;drug file version
SET PSUDFVER=$$VERSION^XPDUTL("PSN")
+7 ;set up section:abbreviation array
DO SECTN^PSUTL1
+8 ;
+9 ;VERSION 6.0 software
+10 IF +PSUOPVER="6"
DO ^PSUOP1
+11 ;
+12 ;VERSION 7.0 software
+13 IF +PSUOPVER'<7
DO ^PSUOP2
+14 ;
+15 ;Mail Man Call
+16 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
Begin DoDot:1
+17 ;Single dose messages
DO EN^PSUOP4
+18 ;Multidose messages
DO EN^PSUOPMD
End DoDot:1
+19 ;
+20 IF $GET(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG"))=1
Begin DoDot:1
+21 SET PSUOPTS="1,2,3,4,5,6,7,8,9,10,11"
+22 SET PSUAUTO=1
End DoDot:1
+23 ;
+24 DO PULL^PSUCP
+25 FOR I=1:1:$LENGTH(PSUOPTS,",")
SET PSUMOD($PIECE(PSUOPTS,",",I))=""
+26 ;Provider extract
IF $DATA(PSUMOD(10))
DO OPSSN^PSUDEM4
+27 ;
+28 ;Rx summary report
+29 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
Begin DoDot:1
+30 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMFLAG"))
DO EN^PSUSUM2
+31 ;
+32 ;IV/UD/RX summary report
+33 IF $DATA(PSUMOD(2))&$DATA(PSUMOD(1))&$DATA(PSUMOD(4))
Begin DoDot:2
+34 DO EN^PSUSUM6
End DoDot:2
+35 ;
+36 ;IV/RX summary report
+37 IF $DATA(PSUMOD(1))&'$DATA(PSUMOD(2))&$DATA(PSUMOD(4))
Begin DoDot:2
+38 DO EN^PSUSUM7
End DoDot:2
+39 ;
+40 ;UD/RX summary report
+41 IF '$DATA(PSUMOD(1))&$DATA(PSUMOD(2))&$DATA(PSUMOD(4))
Begin DoDot:2
+42 DO EN^PSUSUM7
End DoDot:2
End DoDot:1
+43 ;
+44 ;AMIS SUMMARY REPORT
DO EN^PSUOP8
+45 ;
+46 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
+47 ;
+48 DO CLEAN
+49 QUIT
+50 ;
PRINT ;Call print routine
+1 ;
+2 DO ^PSUOP6
+3 ;
+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 DATA,DFN,PSUDFVER,ENDIT,EXTD,J,NODATA,NONE,PSUOPVER,PSECT,PSOPNFI,PSOPNFR,REC,REC1,REC2,X1,X2,Y,Z,AMIS
+5 DO PULL^PSUCP
DO OPTS^PSUCP
CLEANQ QUIT
