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

QANCNV2 ;HISC/GJC-Cleanup and utilities for data conversions ;10/9/92
 ;;2.0;Incident Reporting;**1,4**;08/07/1992
 ;
KILL ;Kill variables, and quit
 K C,DA,DD,DFN,DIC,DIK,DINUM,DLAYGO,DO,DOT,I,PRMQ0,PRMQ1,PRMQ2,PRMQ5
 K PRMQ8,PRMQAS,PRMQDFN,PRMQDISP,PRMQFF,PRMQI,PRMQIEN,PRMQINC,PRMQME
 K PRMQMS,PRMQPM,PRMQST,PRMQSTA,PRMQYR,QA,QAALPHA,QAN,QANADMDT,QANBAD
 K QANCASE,QANCNT,QANCT,QANDATE,QANDESC,QANDSCPT,QANFLG,QANIEN,QANINCD
 K QANLOC0,QANLOC1,QANLVL,QANMED,QANMSSG,QANNODE,QANPAT,QANPID,QANPTY
 K QANRPT,QANSERV,QANSLEV,QANSTRG,QANSUB,QANSUB1,QANTREAT,QANVV,QANWARD
 K QANNON,QANWT,QANXIT,QANXX,QANZZ,QAQ0,VAIN,VAINDT,X,Y
 Q
DESC ;Description node.
 Q:'QANDSCPT
 S ^QA(742.4,QANIEN(7424),1,0)="^^^^"_DT_"^^^^" ;set the zero node of the multiple.
 S QANSUB="",QANCNT=0
 F  S QANSUB=$O(^TMP($J,QANSUB)) Q:QANSUB=""  D:QANSUB["QAN DESC "
 . S QANSTRG=$P(QANSUB,"QAN DESC ",2)_": ",QANCNT=QANCNT+1,QANSUB1=""
 . F  S QANSUB1=$O(^TMP($J,QANSUB,QANSUB1))  Q:QANSUB1=""  D
 .. I ($L(QANSTRG)+$L(QANSUB1))'>200 S QANSTRG=QANSTRG_QANSUB1_"," Q
 .. I $E(QANSTRG,$L(QANSTRG))="," S QANSTRG=$E(QANSTRG,1,$L(QANSTRG)-1)
 .. S ^QA(742.4,QANIEN(7424),1,QANCNT,0)=QANSTRG,QANCNT=QANCNT+1
 .. S QANSTRG=""
 .. Q
 . I $E(QANSTRG,$L(QANSTRG))="," S QANSTRG=$E(QANSTRG,1,$L(QANSTRG)-1)
 . S ^QA(742.4,QANIEN(7424),1,QANCNT,0)=QANSTRG
 . Q
 S ^QA(742.4,QANIEN(7424),1,0)="^^"_QANCNT_"^"_QANCNT_"^"_DT_"^^^^"
 Q
SERV ;Service conversion.
 F QAN=0:0 S QAN=$O(^PRMQ(513.72,PRMQIEN,6,QAN)) Q:QAN'>0  D
 . S QANSERV=+$P(^PRMQ(513.72,PRMQIEN,6,QAN,0),U)
 . Q:'$D(^DIC(49,QANSERV,0))
 . S QANSERV(0)=$P(^DIC(49,QANSERV,0),U) Q:QANSERV(0)']""
 . I $D(^ECC(730,"B",QANSERV(0))) D
 .. S QANSERV(1)=$O(^ECC(730,"B",QANSERV(0),0))
 .. S:QANSERV(1)]"" ^TMP($J,"QAN RESPONSIBLE SERVICE",QANSERV(1))=""
 .. Q
 . Q
 Q