| [613] | 1 | PSBOPM1 ;BIRMINGHAM/BSR-BCMA OIT HISTORY API ;Oct 2005
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**17**;Mar 2004;Build 1
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Reference/IA
|
|---|
| 6 | ; FILE 53.79
|
|---|
| 7 | ; X-REF AOIP
|
|---|
| 8 | ; X-REF AOIP3
|
|---|
| 9 | ; X-REF AOIP4
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | GETORD(PSBORDNM) ;
|
|---|
| 13 | N XA,NDE
|
|---|
| 14 | S PSBORD=0,XA=PSBORDNM,PSBDT="",NDE=.1
|
|---|
| 15 | Q:PSBORDNM="" PSBORD
|
|---|
| 16 | Q:'$D(^PSB(53.79,"AOIP",DFN,XA)) PSBORD
|
|---|
| 17 | F S PSBDT=$O(^PSB(53.79,"AOIP",DFN,XA,PSBDT)) Q:PSBDT="" D
|
|---|
| 18 | .S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP",DFN,XA,PSBDT,PSBIEN)) Q:PSBIEN="" D
|
|---|
| 19 | ..Q:$P($G(^PSB(53.79,PSBIEN,0)),U,9)="N"
|
|---|
| 20 | ..Q:'$D(^PSB(53.79,PSBIEN,NDE))
|
|---|
| 21 | ..S PSBORD=$P(^PSB(53.79,PSBIEN,NDE),U)
|
|---|
| 22 | ..I PSBORD S PSBORDNM=PSBORD
|
|---|
| 23 | ..S:'PSBORD!(PSBORD="") PSBORD=0,TMP("PSBOIS",$J,XA)=""
|
|---|
| 24 | Q PSBORD
|
|---|
| 25 | ;
|
|---|
| 26 | FINDIENS ; USE PSBOIS,PSBADDS AND PSBSOLS TO FIND ALL IENS FOR THE RPT
|
|---|
| 27 | ;SEARCH FOR UNIT DOSE IENS
|
|---|
| 28 | I $D(TMP("PSBOIS",$J)) S XA="" F S XA=$O(TMP("PSBOIS",$J,XA)) Q:XA="" D
|
|---|
| 29 | .S PSBDT="" F S PSBDT=$O(^PSB(53.79,"AOIP",DFN,XA,PSBDT)) Q:PSBDT="" D
|
|---|
| 30 | ..Q:PSBDT>PSBSTOP
|
|---|
| 31 | ..Q:PSBDT<PSBSTRT
|
|---|
| 32 | ..S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP",DFN,XA,PSBDT,PSBIEN)) Q:PSBIEN="" D
|
|---|
| 33 | ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|---|
| 34 | ...S TMP("PSBIENS",$J,"UD",$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|---|
| 35 | ;
|
|---|
| 36 | ;SEARCH FOR ADDITIVES
|
|---|
| 37 | I $D(TMP("PSBADDS",$J)) S XA="" F S XA=$O(TMP("PSBADDS",$J,XA)) Q:XA="" D
|
|---|
| 38 | .S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP3",DFN,PSBIEN)) Q:PSBIEN="" D
|
|---|
| 39 | ..S XB="" F S XB=$O(^PSB(53.79,"AOIP3",DFN,PSBIEN,XB)) Q:XB="" D
|
|---|
| 40 | ...Q:XB'=XA
|
|---|
| 41 | ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|---|
| 42 | ...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,$P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP D
|
|---|
| 43 | ....S TMP("PSBIENS",$J,"ADD",$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|---|
| 44 | ....S TMP("PSBADDS",$J,XA)=1
|
|---|
| 45 | ;
|
|---|
| 46 | ;SEARCH FOR SOLUTIONS
|
|---|
| 47 | I $D(TMP("PSBSOLS",$J)) S XA="" F S XA=$O(TMP("PSBSOLS",$J,XA)) Q:XA="" D
|
|---|
| 48 | .S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP4",DFN,PSBIEN)) Q:PSBIEN="" D
|
|---|
| 49 | ..S XB="" F S XB=$O(^PSB(53.79,"AOIP4",DFN,PSBIEN,XB)) Q:XB="" D
|
|---|
| 50 | ...Q:XB'=XA
|
|---|
| 51 | ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|---|
| 52 | ...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,$P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP D
|
|---|
| 53 | ....S TMP("PSBIENS",$J,"SOL",$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|---|
| 54 | ....S TMP("PSBSOLS",$J,XA)=1
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
