PSUOPAM ;BIR/DAM - PSU PBM Outpatient AMIS Pharmacy Data Collection; March 2004 ; 1/11/08 11:46am
;;4.0;PHARMACY BENEFITS MANAGEMENT;**13**;MARCH, 2005;Build 3
;
;DBIA's
;Reference to File (#52) supported by DBIA 1878
;
EN ;entry point to gather additional AMIS data. Called from PSUOP2
;
K PSUAM ;Array to hold single dose Medication Instructions
K PSUAMMD ;Array to hold multidose medication instructions
K PSUMDFLG ;Multidose flag
S (PSUPI,PSUCO,PSUEXP,PSUAM,PSUDSG,PSUDIPU,PSUNITS,PSUNOUN)=""
S (PSUDUR,PSUCONJ,PSUROUT,PSUSCHED,PSUVERB)=""
D CO
D EXP
D DOSG
Q
;
;
CO ;Copay status: found in file (#52), field (#105)
;
;PSU*4*13 Corrected to show the COPAY.
S PSUCO=$P($G(^TMP("PSOR",$J,PSURXIEN,"IB")),U,1)
I $G(PSUCO) S PSUCOPAY="Y"
I '$G(PSUCO) S PSUCOPAY="N"
Q
;
EXP ;Expanded instructions: found in file (#52), multiple (#113),
;sub-field (#.01)
;
S PSUD1=0
F S PSUD1=$O(^TMP("PSOR",$J,PSURXIEN,"PI",PSUD1)) Q:PSUD1="" D
.I PSUD1=1 S PSUEXP=$E(^TMP("PSOR",$J,PSURXIEN,"PI",PSUD1,0),1,80) D
..S PSUPI=$G(PSUEXP)
.I (PSUD1'=1),($L(PSUEXP)<80) D
..S PSUEXP=$E(PSUEXP_" "_^TMP("PSOR",$J,PSURXIEN,"PI",PSUD1,0),1,80)
..S PSUPI=$G(PSUEXP)
;
Q
;
DOSG ;Dosage data: found in file (#52), multiple (#113). There are
;nine sub-fields to be pulled: #.01 through #8
;
S PSUD1=0
F S PSUD1=$O(^TMP("PSOR",$J,PSURXIEN,"MI",PSUD1)) Q:PSUD1="" D
.I PSUD1'=1 S PSUMDFLG="M" ;Multidose flag
.I PSUD1=1 D ;Single dose/first Multidose data
..S PSUAM=^TMP("PSOR",$J,PSURXIEN,"MI",PSUD1,0)
..S PSUDSG=$P(PSUAM,U,1) ;Dosage Ordered
..S PSUDISPU=$P(PSUAM,U,2) ;Dispense Units per Dose
..S PSUNITS=$P($P(PSUAM,U,3),";",2) ;Units
..S PSUNOUN=$P(PSUAM,U,4) ;Noun
..S PSUDUR=$P(PSUAM,U,5) ;Duration
..S PSUCONJ=$P(PSUAM,U,6) ;Conjunction
..S PSUROUT=$P($P(PSUAM,U,7),";",2) ;Route
..S PSUSCHED=$P(PSUAM,U,8) ;Schedule
..S PSUVERB=$P(PSUAM,U,9) ;Verb
;
Q
;
MULTI ;Set variables for Multidose Medication Instructions
;Called from PSUOP3
;
S (PSUDSGMD,PSUDSPMD,PSUNITMD,PSUNMD)=""
S (PSURTMD,PSUSCHMD,PSUVRBMD)=""
;
S PSUDSGMD=$P(PSUAMMD,U,1) ;Dosage Ordered
S PSUDSPMD=$P(PSUAMMD,U,2) ;Dispense Units per Dose
S PSUNITMD=$P($P(PSUAMMD,U,3),";",2) ;Units
S PSUNMD=$P(PSUAMMD,U,4) ;Noun
S PSUDURMD=$P(PSUAMMD,U,5) ;Duration
S PSUCONMD=$P(PSUAMMD,U,6) ;Conjunction
S PSURTMD=$P($P(PSUAMMD,U,7),";",2) ;Route
S PSUSCHMD=$P(PSUAMMD,U,8) ;Schedule
S PSUVRBMD=$P(PSUAMMD,U,9) ;Verb
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOPAM 2711 printed Apr 09, 2024@21:31:15 Page 2
PSUOPAM ;BIR/DAM - PSU PBM Outpatient AMIS Pharmacy Data Collection; March 2004 ; 1/11/08 11:46am
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**13**;MARCH, 2005;Build 3
+2 ;
+3 ;DBIA's
+4 ;Reference to File (#52) supported by DBIA 1878
+5 ;
EN ;entry point to gather additional AMIS data. Called from PSUOP2
+1 ;
+2 ;Array to hold single dose Medication Instructions
KILL PSUAM
+3 ;Array to hold multidose medication instructions
KILL PSUAMMD
+4 ;Multidose flag
KILL PSUMDFLG
+5 SET (PSUPI,PSUCO,PSUEXP,PSUAM,PSUDSG,PSUDIPU,PSUNITS,PSUNOUN)=""
+6 SET (PSUDUR,PSUCONJ,PSUROUT,PSUSCHED,PSUVERB)=""
+7 DO CO
+8 DO EXP
+9 DO DOSG
+10 QUIT
+11 ;
+12 ;
CO ;Copay status: found in file (#52), field (#105)
+1 ;
+2 ;PSU*4*13 Corrected to show the COPAY.
+3 SET PSUCO=$PIECE($GET(^TMP("PSOR",$JOB,PSURXIEN,"IB")),U,1)
+4 IF $GET(PSUCO)
SET PSUCOPAY="Y"
+5 IF '$GET(PSUCO)
SET PSUCOPAY="N"
+6 QUIT
+7 ;
EXP ;Expanded instructions: found in file (#52), multiple (#113),
+1 ;sub-field (#.01)
+2 ;
+3 SET PSUD1=0
+4 FOR
SET PSUD1=$ORDER(^TMP("PSOR",$JOB,PSURXIEN,"PI",PSUD1))
if PSUD1=""
QUIT
Begin DoDot:1
+5 IF PSUD1=1
SET PSUEXP=$EXTRACT(^TMP("PSOR",$JOB,PSURXIEN,"PI",PSUD1,0),1,80)
Begin DoDot:2
+6 SET PSUPI=$GET(PSUEXP)
End DoDot:2
+7 IF (PSUD1'=1)
IF ($LENGTH(PSUEXP)<80)
Begin DoDot:2
+8 SET PSUEXP=$EXTRACT(PSUEXP_" "_^TMP("PSOR",$JOB,PSURXIEN,"PI",PSUD1,0),1,80)
+9 SET PSUPI=$GET(PSUEXP)
End DoDot:2
End DoDot:1
+10 ;
+11 QUIT
+12 ;
DOSG ;Dosage data: found in file (#52), multiple (#113). There are
+1 ;nine sub-fields to be pulled: #.01 through #8
+2 ;
+3 SET PSUD1=0
+4 FOR
SET PSUD1=$ORDER(^TMP("PSOR",$JOB,PSURXIEN,"MI",PSUD1))
if PSUD1=""
QUIT
Begin DoDot:1
+5 ;Multidose flag
IF PSUD1'=1
SET PSUMDFLG="M"
+6 ;Single dose/first Multidose data
IF PSUD1=1
Begin DoDot:2
+7 SET PSUAM=^TMP("PSOR",$JOB,PSURXIEN,"MI",PSUD1,0)
+8 ;Dosage Ordered
SET PSUDSG=$PIECE(PSUAM,U,1)
+9 ;Dispense Units per Dose
SET PSUDISPU=$PIECE(PSUAM,U,2)
+10 ;Units
SET PSUNITS=$PIECE($PIECE(PSUAM,U,3),";",2)
+11 ;Noun
SET PSUNOUN=$PIECE(PSUAM,U,4)
+12 ;Duration
SET PSUDUR=$PIECE(PSUAM,U,5)
+13 ;Conjunction
SET PSUCONJ=$PIECE(PSUAM,U,6)
+14 ;Route
SET PSUROUT=$PIECE($PIECE(PSUAM,U,7),";",2)
+15 ;Schedule
SET PSUSCHED=$PIECE(PSUAM,U,8)
+16 ;Verb
SET PSUVERB=$PIECE(PSUAM,U,9)
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
+19 ;
MULTI ;Set variables for Multidose Medication Instructions
+1 ;Called from PSUOP3
+2 ;
+3 SET (PSUDSGMD,PSUDSPMD,PSUNITMD,PSUNMD)=""
+4 SET (PSURTMD,PSUSCHMD,PSUVRBMD)=""
+5 ;
+6 ;Dosage Ordered
SET PSUDSGMD=$PIECE(PSUAMMD,U,1)
+7 ;Dispense Units per Dose
SET PSUDSPMD=$PIECE(PSUAMMD,U,2)
+8 ;Units
SET PSUNITMD=$PIECE($PIECE(PSUAMMD,U,3),";",2)
+9 ;Noun
SET PSUNMD=$PIECE(PSUAMMD,U,4)
+10 ;Duration
SET PSUDURMD=$PIECE(PSUAMMD,U,5)
+11 ;Conjunction
SET PSUCONMD=$PIECE(PSUAMMD,U,6)
+12 ;Route
SET PSURTMD=$PIECE($PIECE(PSUAMMD,U,7),";",2)
+13 ;Schedule
SET PSUSCHMD=$PIECE(PSUAMMD,U,8)
+14 ;Verb
SET PSUVRBMD=$PIECE(PSUAMMD,U,9)
+15 ;
+16 QUIT
