QANCNV3 ;HISC/GJC,DAD-Conversion of data from V1.01 to V2.0 ;10/9/92
;;2.0;Incident Reporting;**1**;08/07/1992
DESC ;Incident descriptive data.
S QANDSCPT=0 ;flag condition for descriptive data '1' for yes, '0' for no
I $D(^PRMQ(513.72,PRMQIEN,"PM",0)) S QANDSCPT=1 D DESC1
I $D(^PRMQ(513.72,PRMQIEN,"MS",0)) S QANDSCPT=1 D DESC2
I $D(^PRMQ(513.72,PRMQIEN,"AS",0)) S QANDSCPT=1 D DESC3
I $P(PRMQ0,U,14)]"" S QANDSCPT=1,^TMP($J,"QAN DESC DESCRIPTION",$P(PRMQ0,U,14))=""
I $P(PRMQ0,U,18)]"" S QANDSCPT=1,^TMP($J,"QAN DESC PROCEDURE",$P(PRMQ0,U,18))=""
Q
DESC1 ;Descriptive data part 1
F QAN=0:0 S QAN=$O(^PRMQ(513.72,PRMQIEN,"PM",QAN)) Q:QAN'>0 S QANDESC(0)=$P(^(QAN,0),U) D
. I QANDESC(0)]"" S Y=QANDESC(0),C=$P($G(^DD(513.7222,.01,0)),U,2) D Y^DIQ
. I QANDESC(0)]"",(Y]"") S ^TMP($J,"QAN DESC PROTECTIVE MEASURES",Y)=""
Q
DESC2 ;Descriptive data part 2
F QAN=0:0 S QAN=$O(^PRMQ(513.72,PRMQIEN,"MS",QAN)) Q:QAN'>0 S QANDESC(0)=$P(^(QAN,0),U) D
. I QANDESC(0)]"" S Y=QANDESC(0),C=$P($G(^DD(513.7223,.01,0)),U,2) D Y^DIQ
. I QANDESC(0)]"",(Y]"") S ^TMP($J,"QAN DESC PATIENT MENTAL STATUS",Y)=""
Q
DESC3 ;Descriptive data part 3
F QAN=0:0 S QAN=$O(^PRMQ(513.72,PRMQIEN,"AS",QAN)) Q:QAN'>0 S QANDESC(0)=$P(^(QAN,0),U) D
. I QANDESC(0)]"" S Y=QANDESC(0),C=$P($G(^DD(513.7224,.01,0)),U,2) D Y^DIQ
. I QANDESC(0)]"",(Y]"") S ^TMP($J,"QAN DESC PATIENT ACTIVITY STATUS",Y)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANCNV3 1416 printed Oct 16, 2024@18:00:26 Page 2
QANCNV3 ;HISC/GJC,DAD-Conversion of data from V1.01 to V2.0 ;10/9/92
+1 ;;2.0;Incident Reporting;**1**;08/07/1992
DESC ;Incident descriptive data.
+1 ;flag condition for descriptive data '1' for yes, '0' for no
SET QANDSCPT=0
+2 IF $DATA(^PRMQ(513.72,PRMQIEN,"PM",0))
SET QANDSCPT=1
DO DESC1
+3 IF $DATA(^PRMQ(513.72,PRMQIEN,"MS",0))
SET QANDSCPT=1
DO DESC2
+4 IF $DATA(^PRMQ(513.72,PRMQIEN,"AS",0))
SET QANDSCPT=1
DO DESC3
+5 IF $PIECE(PRMQ0,U,14)]""
SET QANDSCPT=1
SET ^TMP($JOB,"QAN DESC DESCRIPTION",$PIECE(PRMQ0,U,14))=""
+6 IF $PIECE(PRMQ0,U,18)]""
SET QANDSCPT=1
SET ^TMP($JOB,"QAN DESC PROCEDURE",$PIECE(PRMQ0,U,18))=""
+7 QUIT
DESC1 ;Descriptive data part 1
+1 FOR QAN=0:0
SET QAN=$ORDER(^PRMQ(513.72,PRMQIEN,"PM",QAN))
if QAN'>0
QUIT
SET QANDESC(0)=$PIECE(^(QAN,0),U)
Begin DoDot:1
+2 IF QANDESC(0)]""
SET Y=QANDESC(0)
SET C=$PIECE($GET(^DD(513.7222,.01,0)),U,2)
DO Y^DIQ
+3 IF QANDESC(0)]""
IF (Y]"")
SET ^TMP($JOB,"QAN DESC PROTECTIVE MEASURES",Y)=""
End DoDot:1
+4 QUIT
DESC2 ;Descriptive data part 2
+1 FOR QAN=0:0
SET QAN=$ORDER(^PRMQ(513.72,PRMQIEN,"MS",QAN))
if QAN'>0
QUIT
SET QANDESC(0)=$PIECE(^(QAN,0),U)
Begin DoDot:1
+2 IF QANDESC(0)]""
SET Y=QANDESC(0)
SET C=$PIECE($GET(^DD(513.7223,.01,0)),U,2)
DO Y^DIQ
+3 IF QANDESC(0)]""
IF (Y]"")
SET ^TMP($JOB,"QAN DESC PATIENT MENTAL STATUS",Y)=""
End DoDot:1
+4 QUIT
DESC3 ;Descriptive data part 3
+1 FOR QAN=0:0
SET QAN=$ORDER(^PRMQ(513.72,PRMQIEN,"AS",QAN))
if QAN'>0
QUIT
SET QANDESC(0)=$PIECE(^(QAN,0),U)
Begin DoDot:1
+2 IF QANDESC(0)]""
SET Y=QANDESC(0)
SET C=$PIECE($GET(^DD(513.7224,.01,0)),U,2)
DO Y^DIQ
+3 IF QANDESC(0)]""
IF (Y]"")
SET ^TMP($JOB,"QAN DESC PATIENT ACTIVITY STATUS",Y)=""
End DoDot:1
+4 QUIT
