| [613] | 1 | PSJ010 ;BIR/RSB-UTILITY ROUTINE FOR PSJ*5.0*10 ; 15 Apr 98 / 8:01 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**10**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | D 1,2,3 Q
|
|---|
| 5 | ; ***** Convert field .13 and .14 in 59.6 to fields .19 and .2
|
|---|
| 6 | 1 N X,PSJW,PSJP,PSJN,PSJF
|
|---|
| 7 | F PSJW=0:0 S PSJW=$O(^PS(59.6,PSJW)) Q:'PSJW D
|
|---|
| 8 | .F PSJF=13,14 D
|
|---|
| 9 | ..I $L($P($G(^PS(59.6,PSJW,0)),"^",PSJF)) S PSJN=$P(^(0),"^",PSJF) D
|
|---|
| 10 | ...K DIC S X=PSJN,DIC="^%ZIS(1,",DIC(0)="XOS" D ^DIC S:+Y>0 $P(^PS(59.6,PSJW,0),"^",(PSJF+6))=+Y
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | ; ***** Convert field .07 in 53.45 to field .13
|
|---|
| 15 | 2 N X,PSJW,PSJP,PSJN,PSJF
|
|---|
| 16 | F PSJW=0:0 S PSJW=$O(^PS(53.45,PSJW)) Q:'PSJW D
|
|---|
| 17 | .F PSJF=7 D
|
|---|
| 18 | ..I $L($P($G(^PS(53.45,PSJW,0)),"^",PSJF)) S PSJN=$P(^(0),"^",PSJF) D
|
|---|
| 19 | ...K DIC S X=PSJN,DIC="^%ZIS(1,",DIC(0)="XOS" D ^DIC S:+Y>0 $P(^PS(53.45,PSJW,0),"^",(PSJF+6))=+Y
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | ; ***** Convert field 30 in 57.5 to field 32
|
|---|
| 24 | 3 N X,PSJW,PSJP,PSJN,PSJF
|
|---|
| 25 | F PSJW=0:0 S PSJW=$O(^PS(57.5,PSJW)) Q:'PSJW D
|
|---|
| 26 | .F PSJF=1 D
|
|---|
| 27 | ..I $L($P($G(^PS(57.5,PSJW,3)),"^",PSJF)) S PSJN=$P(^(3),"^",PSJF) D
|
|---|
| 28 | ...K DIC S X=PSJN,DIC="^%ZIS(1,",DIC(0)="XOS" D ^DIC S:+Y>0 $P(^PS(57.5,PSJW,3),"^",(PSJF+2))=+Y
|
|---|
| 29 | Q
|
|---|
