source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANCNV2.m@ 1474

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1QANCNV2 ;HISC/GJC-Cleanup and utilities for data conversions ;10/9/92
2 ;;2.0;Incident Reporting;**1,4**;08/07/1992
3 ;
4KILL ;Kill variables, and quit
5 K C,DA,DD,DFN,DIC,DIK,DINUM,DLAYGO,DO,DOT,I,PRMQ0,PRMQ1,PRMQ2,PRMQ5
6 K PRMQ8,PRMQAS,PRMQDFN,PRMQDISP,PRMQFF,PRMQI,PRMQIEN,PRMQINC,PRMQME
7 K PRMQMS,PRMQPM,PRMQST,PRMQSTA,PRMQYR,QA,QAALPHA,QAN,QANADMDT,QANBAD
8 K QANCASE,QANCNT,QANCT,QANDATE,QANDESC,QANDSCPT,QANFLG,QANIEN,QANINCD
9 K QANLOC0,QANLOC1,QANLVL,QANMED,QANMSSG,QANNODE,QANPAT,QANPID,QANPTY
10 K QANRPT,QANSERV,QANSLEV,QANSTRG,QANSUB,QANSUB1,QANTREAT,QANVV,QANWARD
11 K QANNON,QANWT,QANXIT,QANXX,QANZZ,QAQ0,VAIN,VAINDT,X,Y
12 Q
13DESC ;Description node.
14 Q:'QANDSCPT
15 S ^QA(742.4,QANIEN(7424),1,0)="^^^^"_DT_"^^^^" ;set the zero node of the multiple.
16 S QANSUB="",QANCNT=0
17 F S QANSUB=$O(^TMP($J,QANSUB)) Q:QANSUB="" D:QANSUB["QAN DESC "
18 . S QANSTRG=$P(QANSUB,"QAN DESC ",2)_": ",QANCNT=QANCNT+1,QANSUB1=""
19 . F S QANSUB1=$O(^TMP($J,QANSUB,QANSUB1)) Q:QANSUB1="" D
20 .. I ($L(QANSTRG)+$L(QANSUB1))'>200 S QANSTRG=QANSTRG_QANSUB1_"," Q
21 .. I $E(QANSTRG,$L(QANSTRG))="," S QANSTRG=$E(QANSTRG,1,$L(QANSTRG)-1)
22 .. S ^QA(742.4,QANIEN(7424),1,QANCNT,0)=QANSTRG,QANCNT=QANCNT+1
23 .. S QANSTRG=""
24 .. Q
25 . I $E(QANSTRG,$L(QANSTRG))="," S QANSTRG=$E(QANSTRG,1,$L(QANSTRG)-1)
26 . S ^QA(742.4,QANIEN(7424),1,QANCNT,0)=QANSTRG
27 . Q
28 S ^QA(742.4,QANIEN(7424),1,0)="^^"_QANCNT_"^"_QANCNT_"^"_DT_"^^^^"
29 Q
30SERV ;Service conversion.
31 F QAN=0:0 S QAN=$O(^PRMQ(513.72,PRMQIEN,6,QAN)) Q:QAN'>0 D
32 . S QANSERV=+$P(^PRMQ(513.72,PRMQIEN,6,QAN,0),U)
33 . Q:'$D(^DIC(49,QANSERV,0))
34 . S QANSERV(0)=$P(^DIC(49,QANSERV,0),U) Q:QANSERV(0)']""
35 . I $D(^ECC(730,"B",QANSERV(0))) D
36 .. S QANSERV(1)=$O(^ECC(730,"B",QANSERV(0),0))
37 .. S:QANSERV(1)]"" ^TMP($J,"QAN RESPONSIBLE SERVICE",QANSERV(1))=""
38 .. Q
39 . Q
40 Q
Note: See TracBrowser for help on using the repository browser.