source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSP134.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PSSP134 ;REPORT OF REFORMATTED LOCAL POSSIBLE DOSES
2 ;;1.0;PHARMACY DATA MANAGEMENT;**134**;9/30/97;Build 8
3 ;
4LOOP ;LOOP THROUGH DRUG FILE FOR ALL LOCAL POSSIBLE DOSES
5 N PSSDRUG,PSSLPD2,PSSNLPD,PSSLPDX,PSSXDT,X1,X2,X,PSSDRUGN
6 K ^XTMP("PSSP134")
7 S X1=DT,X2=90 D C^%DTC S PSSXDT=$G(X)
8 S ^XTMP("PSSP134",0)=PSSXDT_"^"_DT
9 S PSSDRUG=0 F S PSSDRUG=$O(^PSDRUG(PSSDRUG)) Q:'PSSDRUG D
10 .S PSSLPDX=0 F S PSSLPDX=$O(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX)) Q:'PSSLPDX D
11 ..S PSSLPD2=$P($G(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX,0)),"^",1)
12 ..I PSSLPD2="" Q
13 ..S PSSNLPD=$$DOSE(PSSLPD2)
14 ..S PSSDRUGN=$P($G(^PSDRUG(PSSDRUG,0)),"^")
15 ..S ^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)=PSSLPD2_"^"_PSSNLPD
16 D REPORT
17 Q
18 ;
19DOSE(PSSDOSE) ;
20 N PSSCHAR,PSSXX,PSSDOSR
21 S (PSSXX,PSSDOSR)=""
22 F PSSXX=1:1:$L(PSSDOSE) D
23 .S PSSCHAR=$E(PSSDOSE,PSSXX)
24 .I PSSCHAR=".",$E(PSSDOSE,PSSXX+1),$E(PSSDOSR,$L(PSSDOSR))'?1N S PSSCHAR=0_PSSCHAR
25 .I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))?1N,PSSCHAR'?1N,"() -./%,"'[PSSCHAR S PSSDOSR=PSSDOSR_" "_PSSCHAR Q
26 .I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))'?1N,"() -./%,"'[$E(PSSDOSR,$L(PSSDOSR)),PSSCHAR?1N S PSSDOSR=PSSDOSR_" "_PSSCHAR Q
27 .I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))?1N,PSSCHAR'?1N S PSSDOSR=PSSDOSR_PSSCHAR Q
28 .I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))'?1N,PSSCHAR'?1N S PSSDOSR=PSSDOSR_PSSCHAR Q
29 .S PSSDOSR=PSSDOSR_PSSCHAR
30 .Q
31 Q PSSDOSR
32 ;
33REPORT ;REPORT OF LOCAL POSSIBLE DOSES BEFORE AND AFTER
34 N XMDUZ,XMSUB,XMTEXT,XMY,Y,PSSDT,PSSXDT,DIFROM,PSSI
35 K ^XTMP("PSSP134R")
36 S X1=DT,X2=90 D C^%DTC S PSSXDT=$G(X)
37 S ^XTMP("PSSP134R",0)=PSSXDT_"^"_DT
38 S XMDUZ="REFORMATTED LOCAL POSSIBLE DOSES",XMSUB="REFORMATTED LOCAL POSSIBLE DOSES",XMTEXT="^XTMP(""PSSP134R"","
39 I $D(^XUSEC("PSNMGR")) F PSSI=0:0 S PSSI=$O(^XUSEC("PSNMGR",PSSI)) Q:'PSSI S XMY(PSSI)=""
40 D NOW^%DTC S Y=% X ^DD("DD") S PSSDT=Y
41 S ^XTMP("PSSP134R",1)="REFORMATTED LOCAL POSSIBLE DOSES USING API ASSOCIATED WITH PSS*1.0*78"
42 S ^XTMP("PSSP134R",2)=PSSDT
43 S ^XTMP("PSSP134R",3)=""
44 N PSSLPD,PSSNLPD,PSSDRUG,PSSLPDX,PSSLPDD,PSSLINE,PSSXX,PSSDRUGN,PSSSPC,PSSX
45 ;
46 S PSSXX=4,PSSLINE="",PSSSPC=""
47 F PSSX=1:1:50 S $E(PSSLINE,PSSXX)="-",$E(PSSSPC,PSSXX)=" "
48 S PSSDRUGN="" F S PSSDRUGN=$O(^XTMP("PSSP134",PSSDRUGN)) Q:PSSDRUGN="" D
49 .S PSSDRUG=0 F S PSSDRUG=$O(^XTMP("PSSP134",PSSDRUGN,PSSDRUG)) Q:'PSSDRUG D
50 ..S ^XTMP("PSSP134R",PSSXX)=$P($G(^PSDRUG(PSSDRUG,0)),"^",1)_" (#"_PSSDRUG_")"
51 ..S PSSXX=PSSXX+1
52 ..S PSSLPDX=0 F S PSSLPDX=$O(^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)) Q:'PSSLPDX D
53 ...S PSSLPDD=^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)
54 ...S PSSLPD=$P(PSSLPDD,"^"),PSSNLPD=$P(PSSLPDD,"^",2)
55 ...S ^XTMP("PSSP134R",PSSXX)=$E(PSSSPC,1,10)_PSSLPD
56 ...S ^XTMP("PSSP134R",PSSXX+1)=$E(PSSSPC,1,10)_PSSNLPD
57 ...S ^XTMP("PSSP134R",PSSXX+2)=""
58 ...S PSSXX=PSSXX+3
59 D ^XMD
60 Q
Note: See TracBrowser for help on using the repository browser.