source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ010.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1PSJ010 ;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
61 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
152 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
243 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
Note: See TracBrowser for help on using the repository browser.