- PSO5291 ;BHM/DB - TPB Eligibility file API ; 18 JUL 05
- ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
- PSO(PSOIEN,PSOTXT,LIST) ;SDD 3.2.21
- ;PSOIEN - IEN
- ;PSOTXT - FREE TEXT ENTRY
- Q:$G(LIST)=""
- N DA,DIC,DR,DIQ,X K ^TMP($J,LIST),^UTILITY("DIQ1",$J)
- I $G(PSOIEN)="",$G(PSOTXT)="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I $G(PSOIEN)]"" D G Q
- .I '$G(^PS(52.91,PSOIEN,0)) S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q
- .S DA=PSOIEN D TMP
- I $G(PSOTXT)]"" D G Q
- .S DA=$O(^DPT("B",PSOTXT,0)) I DA="" S ^TMP($J,LIST,PSOTXT,0)="-1^NO DATA FOUND" Q
- .D TMP
- Q
- TMP S ^TMP($J,LIST,DA,0)=1
- S DIC=52.91,DR=".01:11",DIQ(0)="IE"
- D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J)) S ^TMP($J,LIST,DA,0)="-1^NO DATA FOUND" Q
- F X=.01,1,2,3,4,5,6,7,8,9,10,11 D
- .S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,52.91,DA,X,"I"))
- .S ^TMP($J,LIST,DA,X)=$S($G(^UTILITY("DIQ1",$J,52.91,DA,X,"E"))'="":^TMP($J,LIST,DA,X)_"^"_$G(^UTILITY("DIQ1",$J,52.91,DA,X,"E")),1:"")
- S DFN=$G(^UTILITY("DIQ1",$J,52.91,DA,.01,"I")),^TMP($J,LIST,"B",DFN,DA)=""
- K ^UTILITY("DIQ1",$J)
- Q
- Q K DA,DFN,DIC,DIQ,DR,LIST,PSOIEN,PSOTXT,X Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO5291 1105 printed Mar 13, 2025@21:27:59 Page 2
- PSO5291 ;BHM/DB - TPB Eligibility file API ; 18 JUL 05
- +1 ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
- PSO(PSOIEN,PSOTXT,LIST) ;SDD 3.2.21
- +1 ;PSOIEN - IEN
- +2 ;PSOTXT - FREE TEXT ENTRY
- +3 if $GET(LIST)=""
- QUIT
- +4 NEW DA,DIC,DR,DIQ,X
- KILL ^TMP($JOB,LIST),^UTILITY("DIQ1",$JOB)
- +5 IF $GET(PSOIEN)=""
- IF $GET(PSOTXT)=""
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +6 IF $GET(PSOIEN)]""
- Begin DoDot:1
- +7 IF '$GET(^PS(52.91,PSOIEN,0))
- SET ^TMP($JOB,LIST,PSOIEN,0)="-1^NO DATA FOUND"
- QUIT
- +8 SET DA=PSOIEN
- DO TMP
- End DoDot:1
- GOTO Q
- +9 IF $GET(PSOTXT)]""
- Begin DoDot:1
- +10 SET DA=$ORDER(^DPT("B",PSOTXT,0))
- IF DA=""
- SET ^TMP($JOB,LIST,PSOTXT,0)="-1^NO DATA FOUND"
- QUIT
- +11 DO TMP
- End DoDot:1
- GOTO Q
- +12 QUIT
- TMP SET ^TMP($JOB,LIST,DA,0)=1
- +1 SET DIC=52.91
- SET DR=".01:11"
- SET DIQ(0)="IE"
- +2 DO EN^DIQ1
- IF '$DATA(^UTILITY("DIQ1",$JOB))
- SET ^TMP($JOB,LIST,DA,0)="-1^NO DATA FOUND"
- QUIT
- +3 FOR X=.01,1,2,3,4,5,6,7,8,9,10,11
- Begin DoDot:1
- +4 SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"I"))
- +5 SET ^TMP($JOB,LIST,DA,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"E"))'="":^TMP($JOB,LIST,DA,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,52.91,DA,X,"E")),1:"")
- End DoDot:1
- +6 SET DFN=$GET(^UTILITY("DIQ1",$JOB,52.91,DA,.01,"I"))
- SET ^TMP($JOB,LIST,"B",DFN,DA)=""
- +7 KILL ^UTILITY("DIQ1",$JOB)
- +8 QUIT
- Q KILL DA,DFN,DIC,DIQ,DR,LIST,PSOIEN,PSOTXT,X
- QUIT
