- PSO59 ;BHM/DB - Outpatient Site File API ; 2/9/10 11:04am
- ;;7.0;OUTPATIENT PHARMACY;**213,229,254,267,273,316**;DEC 1997;Build 5
- ;Reference to ^DIC(4 supported by DBIA 2251
- ;Reference to ^DIC(49 supported by DBIA 2250
- ;
- PSS(PSOIEN,PSOTXT,LIST) ;
- N DA,DIC,DR,X,I,DIQ
- I $G(LIST)="" Q
- I $G(LIST)'="" K ^TMP($J,LIST)
- I '$G(PSOIEN),$G(PSOTXT)="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I $G(PSOIEN),$G(PSOTXT)="" D SINGLE Q
- I '$G(PSOIEN),$G(PSOTXT)'="" D
- .I $G(PSOTXT)="??" D ALLDIV Q
- .I $G(PSOTXT)'="??" D SINGLE Q
- I $G(PSOIEN),$G(PSOTXT)'="" S PSOTXT="" D SINGLE Q
- Q
- ;
- SINGLE ;RETURNS SINGLE DIVISION
- K ^TMP($J,LIST) S:$G(PSOIEN)>0 ^TMP($J,LIST,PSOIEN,0)=0
- I $G(PSOIEN)>0,'$D(^PS(59,PSOIEN,0)) S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q
- I $G(PSOTXT)'="",'$D(^PS(59,"B",PSOTXT)),$G(PSOIEN)>0 S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q
- S DA=$S($G(PSOIEN)]"":PSOIEN,1:$O(^PS(59,"B",PSOTXT,0)))
- I $G(DA)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- K ^UTILITY("DIQ1",$J),DIC S DIC=59,DR=".01;.02;.03;.04;.05;.06;.07;.08;1;100;101;1003;1008",DIQ(0)="IE" D EN^DIQ1
- I '$D(^UTILITY("DIQ1",$J)) S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q
- F X=.01,.02,.03,.04,.05,.06,.07,.08,1,100,101,1003,1008 D
- .I $G(^UTILITY("DIQ1",$J,59,DA,X,"I"))'=$G(^UTILITY("DIQ1",$J,59,DA,X,"E")) S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,59,DA,X,"I"))_"^"_$G(^UTILITY("DIQ1",$J,59,DA,X,"E")) Q
- .S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,59,DA,X,"I"))
- S PSOTXT=$G(^UTILITY("DIQ1",$J,59,DA,.01,"E")) S ^TMP($J,LIST,"B",PSOTXT,DA)=""
- S ^TMP($J,LIST,DA,0)=$G(^TMP($J,LIST,DA,0))+1
- K DA,DIC,DIQ,DR,PSOIEN,PSOTXT
- Q
- ;
- ALLDIV ; RETURNS ALL DIVISIONS
- N IEN,SITE S IEN=0,SITE=""
- F S SITE=$O(^PS(59,"B",SITE)) Q:SITE="" D
- .S ^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
- .F S IEN=$O(^PS(59,"B",SITE,IEN)) Q:'IEN D
- ..N PSODIV S PSODIV=$G(^PS(59,IEN,0))
- ..S ^TMP($J,LIST,"B",SITE,IEN)=""
- ..S ^TMP($J,LIST,IEN,.01)=$P($G(PSODIV),U,1)
- ..S ^TMP($J,LIST,IEN,.02)=$P($G(PSODIV),U,2)
- ..S ^TMP($J,LIST,IEN,.03)=$P($G(PSODIV),U,3)
- ..S ^TMP($J,LIST,IEN,.04)=$P($G(PSODIV),U,4)
- ..S ^TMP($J,LIST,IEN,.05)=$P($G(PSODIV),U,5)
- ..S ^TMP($J,LIST,IEN,.06)=$P($G(PSODIV),U,6)
- ..S ^TMP($J,LIST,IEN,.07)=$P($G(PSODIV),U,7)
- ..S ^TMP($J,LIST,IEN,.08)=$S($P($G(PSODIV),U,8)>0:$P($G(PSODIV),U,8)_"^"_$P($G(^DIC(5,$P($G(PSODIV),U,8),0)),U,1),1:"")
- ..S ^TMP($J,LIST,IEN,1)=$P($G(^PS(59,IEN,"SAND")),U,1)
- ..S ^TMP($J,LIST,IEN,100)=$S($P($G(^PS(59,IEN,"INI")),U,1)>0:$P($G(^PS(59,IEN,"INI")),U,1)_"^"_$P($G(^DIC(4,$P($G(^PS(59,IEN,"INI")),U,1),0)),U,1),1:"")
- ..S ^TMP($J,LIST,IEN,101)=$S($P($G(^PS(59,IEN,"INI")),U,2)>0:$P($G(^PS(59,IEN,"INI")),U,2)_"^"_$P($G(^DIC(4,$P($G(^PS(59,IEN,"INI")),U,2),0)),U,1),1:"")
- ..S ^TMP($J,LIST,IEN,1003)=$S($G(^PS(59,IEN,"IB"))>0:$G(^PS(59,IEN,"IB"))_"^"_$P($G(^DIC(49,$G(^PS(59,IEN,"IB")),0)),U,1),1:"")
- ..S ^TMP($J,LIST,IEN,1008)=$P($G(^PS(59,IEN,"SAND")),U,3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO59 2931 printed Feb 18, 2025@23:49:39 Page 2
- PSO59 ;BHM/DB - Outpatient Site File API ; 2/9/10 11:04am
- +1 ;;7.0;OUTPATIENT PHARMACY;**213,229,254,267,273,316**;DEC 1997;Build 5
- +2 ;Reference to ^DIC(4 supported by DBIA 2251
- +3 ;Reference to ^DIC(49 supported by DBIA 2250
- +4 ;
- PSS(PSOIEN,PSOTXT,LIST) ;
- +1 NEW DA,DIC,DR,X,I,DIQ
- +2 IF $GET(LIST)=""
- QUIT
- +3 IF $GET(LIST)'=""
- KILL ^TMP($JOB,LIST)
- +4 IF '$GET(PSOIEN)
- IF $GET(PSOTXT)=""
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +5 IF $GET(PSOIEN)
- IF $GET(PSOTXT)=""
- DO SINGLE
- QUIT
- +6 IF '$GET(PSOIEN)
- IF $GET(PSOTXT)'=""
- Begin DoDot:1
- +7 IF $GET(PSOTXT)="??"
- DO ALLDIV
- QUIT
- +8 IF $GET(PSOTXT)'="??"
- DO SINGLE
- QUIT
- End DoDot:1
- +9 IF $GET(PSOIEN)
- IF $GET(PSOTXT)'=""
- SET PSOTXT=""
- DO SINGLE
- QUIT
- +10 QUIT
- +11 ;
- SINGLE ;RETURNS SINGLE DIVISION
- +1 KILL ^TMP($JOB,LIST)
- if $GET(PSOIEN)>0
- SET ^TMP($JOB,LIST,PSOIEN,0)=0
- +2 IF $GET(PSOIEN)>0
- IF '$DATA(^PS(59,PSOIEN,0))
- SET ^TMP($JOB,LIST,PSOIEN,0)="-1^NO DATA FOUND"
- QUIT
- +3 IF $GET(PSOTXT)'=""
- IF '$DATA(^PS(59,"B",PSOTXT))
- IF $GET(PSOIEN)>0
- SET ^TMP($JOB,LIST,PSOIEN,0)="-1^NO DATA FOUND"
- QUIT
- +4 SET DA=$SELECT($GET(PSOIEN)]"":PSOIEN,1:$ORDER(^PS(59,"B",PSOTXT,0)))
- +5 IF $GET(DA)'>0
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +6 KILL ^UTILITY("DIQ1",$JOB),DIC
- SET DIC=59
- SET DR=".01;.02;.03;.04;.05;.06;.07;.08;1;100;101;1003;1008"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +7 IF '$DATA(^UTILITY("DIQ1",$JOB))
- SET ^TMP($JOB,LIST,PSOIEN,0)="-1^NO DATA FOUND"
- QUIT
- +8 FOR X=.01,.02,.03,.04,.05,.06,.07,.08,1,100,101,1003,1008
- Begin DoDot:1
- +9 IF $GET(^UTILITY("DIQ1",$JOB,59,DA,X,"I"))'=$GET(^UTILITY("DIQ1",$JOB,59,DA,X,"E"))
- SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,59,DA,X,"I"))_"^"_$GET(^UTILITY("DIQ1",$JOB,59,DA,X,"E"))
- QUIT
- +10 SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,59,DA,X,"I"))
- End DoDot:1
- +11 SET PSOTXT=$GET(^UTILITY("DIQ1",$JOB,59,DA,.01,"E"))
- SET ^TMP($JOB,LIST,"B",PSOTXT,DA)=""
- +12 SET ^TMP($JOB,LIST,DA,0)=$GET(^TMP($JOB,LIST,DA,0))+1
- +13 KILL DA,DIC,DIQ,DR,PSOIEN,PSOTXT
- +14 QUIT
- +15 ;
- ALLDIV ; RETURNS ALL DIVISIONS
- +1 NEW IEN,SITE
- SET IEN=0
- SET SITE=""
- +2 FOR
- SET SITE=$ORDER(^PS(59,"B",SITE))
- if SITE=""
- QUIT
- Begin DoDot:1
- +3 SET ^TMP($JOB,LIST,0)=$GET(^TMP($JOB,LIST,0))+1
- +4 FOR
- SET IEN=$ORDER(^PS(59,"B",SITE,IEN))
- if 'IEN
- QUIT
- Begin DoDot:2
- +5 NEW PSODIV
- SET PSODIV=$GET(^PS(59,IEN,0))
- +6 SET ^TMP($JOB,LIST,"B",SITE,IEN)=""
- +7 SET ^TMP($JOB,LIST,IEN,.01)=$PIECE($GET(PSODIV),U,1)
- +8 SET ^TMP($JOB,LIST,IEN,.02)=$PIECE($GET(PSODIV),U,2)
- +9 SET ^TMP($JOB,LIST,IEN,.03)=$PIECE($GET(PSODIV),U,3)
- +10 SET ^TMP($JOB,LIST,IEN,.04)=$PIECE($GET(PSODIV),U,4)
- +11 SET ^TMP($JOB,LIST,IEN,.05)=$PIECE($GET(PSODIV),U,5)
- +12 SET ^TMP($JOB,LIST,IEN,.06)=$PIECE($GET(PSODIV),U,6)
- +13 SET ^TMP($JOB,LIST,IEN,.07)=$PIECE($GET(PSODIV),U,7)
- +14 SET ^TMP($JOB,LIST,IEN,.08)=$SELECT($PIECE($GET(PSODIV),U,8)>0:$PIECE($GET(PSODIV),U,8)_"^"_$PIECE($GET(^DIC(5,$PIECE($GET(PSODIV),U,8),0)),U,1),1:"")
- +15 SET ^TMP($JOB,LIST,IEN,1)=$PIECE($GET(^PS(59,IEN,"SAND")),U,1)
- +16 SET ^TMP($JOB,LIST,IEN,100)=$SELECT($PIECE($GET(^PS(59,IEN,"INI")),U,1)>0:$PIECE($GET(^PS(59,IEN,"INI")),U,1)_"^"_$PIECE($GET(^DIC(4,$PIECE($GET(^PS(59,IEN,"INI")),U,1),0)),U,1),1:"")
- +17 SET ^TMP($JOB,LIST,IEN,101)=$SELECT($PIECE($GET(^PS(59,IEN,"INI")),U,2)>0:$PIECE($GET(^PS(59,IEN,"INI")),U,2)_"^"_$PIECE($GET(^DIC(4,$PIECE($GET(^PS(59,IEN,"INI")),U,2),0)),U,1),1:"")
- +18 SET ^TMP($JOB,LIST,IEN,1003)=$SELECT($GET(^PS(59,IEN,"IB"))>0:$GET(^PS(59,IEN,"IB"))_"^"_$PIECE($GET(^DIC(49,$GET(^PS(59,IEN,"IB")),0)),U,1),1:"")
- +19 SET ^TMP($JOB,LIST,IEN,1008)=$PIECE($GET(^PS(59,IEN,"SAND")),U,3)
- End DoDot:2
- End DoDot:1
- +20 QUIT
