QANCNV1 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;10/9/92
;;2.0;Incident Reporting;**1,4**;08/07/1992
CASE ;Building the case number from old IR data. (File: 513.72)
S QANXIT=0,QAALPHA=99 ;SETS A PARAMETER FOR OUR CASE NUMBER i.e, "c"
S QANMSSG="W !!,""Incomplete Incident Reporting data, for ^PRMQ(513.72,""_PRMQIEN_"",0)."",!,""Contact your site manager."",!!"
S PRMQ0=$G(^PRMQ(513.72,PRMQIEN,0)),PRMQI=$G(^PRMQ(513.72,PRMQIEN,"I"))
I PRMQ0']""!(PRMQI']"") S QANXIT=1
I QANXIT S QANNON=$G(QANNON)+1 Q
S PRMQ2=$G(^PRMQ(513.72,PRMQIEN,2)),PRMQPM=$G(^PRMQ(513.72,PRMQIEN,"PM"))
S PRMQ5=$G(^PRMQ(513.72,PRMQIEN,5)),PRMQ8=$G(^PRMQ(513.72,PRMQIEN,8))
S PRMQ1=$G(^PRMQ(513.72,PRMQIEN,1)),PRMQDISP=$P(PRMQ2,U,21)
S PRMQME=$G(^PRMQ(513.72,PRMQIEN,"ME")),PRMQFF=$G(^PRMQ(513.72,PRMQIEN,"FF"))
S PRMQMS=$G(^PRMQ(513.72,PRMQIEN,"MS")),PRMQAS=$G(^PRMQ(513.72,PRMQIEN,"AS"))
S PRMQINC=$P($G(^PRMQ(513.941,+$P(PRMQI,U),0)),U),QANDATE=$P(PRMQ0,U)
I PRMQINC']"" W !!,*7,"Bad pointer, incident type not found."
I W !,"Bad Node: ^PRMQ(513.72,"_PRMQIEN_",I)",! S QANXIT=1 Q:QANXIT
D EN1^QANCNVT Q:QANXIT ;Convert 'old' incidents to 'new' incidents.
S PRMQYR=$E(QANDATE,2,3)_"0000",PRMQSTA=$P(QAQ0,U) ;QAQ0 set in 'CNV0'
S PRMQST=$S($G(^DIC(4,PRMQSTA,99))]"":$P(^(99),U),1:PRMQSTA)
S PRMQDFN=+$P($G(^QA(742.4,0)),U,3)+1
F Q:$D(^QA(742.4,PRMQDFN,0))=0 S PRMQDFN=PRMQDFN+1
S QANCASE=PRMQST_$C(QAALPHA)_"."_(PRMQYR+PRMQDFN)
;Set up conversion fron 1.0 to 2.0
S QANLOC0=$P(PRMQ0,U,15) ;Incident location
S QANLOC1=$S(QANLOC0="PA":1,QANLOC0="BA":2,QANLOC0="HA":3,QANLOC0="TR":6,QANLOC0="NO":8,QANLOC0="ON":4,QANLOC0="OF":5,1:7)
;QANRPT - Pointer to file 3 (user), QANTREAT - pointer to file 45.7
S QANRPT=$P(PRMQ0,U,6),QANTREAT=$P(PRMQ0,U,10)
S QANWT=$S($P(PRMQ0,U,17)="WI":1,1:0) ;Witnessed?
S QANLVL=$S($P(PRMQ5,U,3)="CA":1,$P(PRMQ5,U,3)="DE":3,$P(PRMQ5,U,3)="AD":2,$P(PRMQ5,U,3)="QA":3,1:"") ;Level of Review 11th piece 0 node, file 742.4
S QANLVL(0)=$P(PRMQ5,U,3) ;Future 'local case status' check
S QANMED=$S($P(PRMQ5,U)="PA":2,$P(PRMQ5,U)="ST":2,$P(PRMQ5,U)="EQ":3,1:"") ;Med Center action 2 node 742.4
D DESC^QANCNV3 ;Grabbing other descriptive fields in 513.72
I $D(^PRMQ(513.72,PRMQIEN,6)) D SERV^QANCNV2 ;Responsible Service
S QANPAT=+$P(PRMQ0,U,2),QANNODE("PAT")=$G(^DPT(QANPAT,0))
S:QANNODE("PAT")']"" QANXIT=1 X:QANXIT QANMSSG Q:QANXIT
S QANPAT("NAME")=$P(QANNODE("PAT"),U) ;QANPAT("NAME") Patient's name
S QANPAT("SSN")=$P(QANNODE("PAT"),U,9)
S:QANPAT("SSN")]"" QANPAT("PT SSN")=$E(QANPAT("SSN"),6,9)
S QANPAT("PT NAME")=$E($P(QANPAT("NAME"),",",2))_$E($P(QANPAT("NAME")," ",2))_$E(QANPAT("NAME"))
I QANPAT("PT NAME")]"",QANPAT("PT SSN")]"" S QANPID=QANPAT("PT NAME")_QANPAT("PT SSN") ;Builds Patient ID
S QANPTY=$S($P(PRMQ0,U,8)="IN":1,$P(PRMQ0,U,8)="OU"!($P(PRMQ0,U,8)="MI"):0,1:"")
S QANWARD=+$P(PRMQ0,U,9),QANWARD=$G(^DIC(42,QANWARD,44)) ;Find ward, map 42 -> 44
S QANSLEV=$S($P(PRMQ0,U,16)="MIT":1,$P(PRMQ0,U,16)="MIP":2,$P(PRMQ0,U,16)="MAT":2,$P(PRMQ0,U,16)="MAP":2,$P(PRMQ0,U,16)="POT":2,$P(PRMQ0,U,16)="DEA":3,$P(PRMQ0,U,16)="NO":0,1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANCNV1 3135 printed Oct 16, 2024@18:00:24 Page 2
QANCNV1 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;10/9/92
+1 ;;2.0;Incident Reporting;**1,4**;08/07/1992
CASE ;Building the case number from old IR data. (File: 513.72)
+1 ;SETS A PARAMETER FOR OUR CASE NUMBER i.e, "c"
SET QANXIT=0
SET QAALPHA=99
+2 SET QANMSSG="W !!,""Incomplete Incident Reporting data, for ^PRMQ(513.72,""_PRMQIEN_"",0)."",!,""Contact your site manager."",!!"
+3 SET PRMQ0=$GET(^PRMQ(513.72,PRMQIEN,0))
SET PRMQI=$GET(^PRMQ(513.72,PRMQIEN,"I"))
+4 IF PRMQ0']""!(PRMQI']"")
SET QANXIT=1
+5 IF QANXIT
SET QANNON=$GET(QANNON)+1
QUIT
+6 SET PRMQ2=$GET(^PRMQ(513.72,PRMQIEN,2))
SET PRMQPM=$GET(^PRMQ(513.72,PRMQIEN,"PM"))
+7 SET PRMQ5=$GET(^PRMQ(513.72,PRMQIEN,5))
SET PRMQ8=$GET(^PRMQ(513.72,PRMQIEN,8))
+8 SET PRMQ1=$GET(^PRMQ(513.72,PRMQIEN,1))
SET PRMQDISP=$PIECE(PRMQ2,U,21)
+9 SET PRMQME=$GET(^PRMQ(513.72,PRMQIEN,"ME"))
SET PRMQFF=$GET(^PRMQ(513.72,PRMQIEN,"FF"))
+10 SET PRMQMS=$GET(^PRMQ(513.72,PRMQIEN,"MS"))
SET PRMQAS=$GET(^PRMQ(513.72,PRMQIEN,"AS"))
+11 SET PRMQINC=$PIECE($GET(^PRMQ(513.941,+$PIECE(PRMQI,U),0)),U)
SET QANDATE=$PIECE(PRMQ0,U)
+12 IF PRMQINC']""
WRITE !!,*7,"Bad pointer, incident type not found."
+13 IF $TEST
WRITE !,"Bad Node: ^PRMQ(513.72,"_PRMQIEN_",I)",!
SET QANXIT=1
if QANXIT
QUIT
+14 ;Convert 'old' incidents to 'new' incidents.
DO EN1^QANCNVT
if QANXIT
QUIT
+15 ;QAQ0 set in 'CNV0'
SET PRMQYR=$EXTRACT(QANDATE,2,3)_"0000"
SET PRMQSTA=$PIECE(QAQ0,U)
+16 SET PRMQST=$SELECT($GET(^DIC(4,PRMQSTA,99))]"":$PIECE(^(99),U),1:PRMQSTA)
+17 SET PRMQDFN=+$PIECE($GET(^QA(742.4,0)),U,3)+1
+18 FOR
if $DATA(^QA(742.4,PRMQDFN,0))=0
QUIT
SET PRMQDFN=PRMQDFN+1
+19 SET QANCASE=PRMQST_$CHAR(QAALPHA)_"."_(PRMQYR+PRMQDFN)
+20 ;Set up conversion fron 1.0 to 2.0
+21 ;Incident location
SET QANLOC0=$PIECE(PRMQ0,U,15)
+22 SET QANLOC1=$SELECT(QANLOC0="PA":1,QANLOC0="BA":2,QANLOC0="HA":3,QANLOC0="TR":6,QANLOC0="NO":8,QANLOC0="ON":4,QANLOC0="OF":5,1:7)
+23 ;QANRPT - Pointer to file 3 (user), QANTREAT - pointer to file 45.7
+24 SET QANRPT=$PIECE(PRMQ0,U,6)
SET QANTREAT=$PIECE(PRMQ0,U,10)
+25 ;Witnessed?
SET QANWT=$SELECT($PIECE(PRMQ0,U,17)="WI":1,1:0)
+26 ;Level of Review 11th piece 0 node, file 742.4
SET QANLVL=$SELECT($PIECE(PRMQ5,U,3)="CA":1,$PIECE(PRMQ5,U,3)="DE":3,$PIECE(PRMQ5,U,3)="AD":2,$PIECE(PRMQ5,U,3)="QA":3,1:"")
+27 ;Future 'local case status' check
SET QANLVL(0)=$PIECE(PRMQ5,U,3)
+28 ;Med Center action 2 node 742.4
SET QANMED=$SELECT($PIECE(PRMQ5,U)="PA":2,$PIECE(PRMQ5,U)="ST":2,$PIECE(PRMQ5,U)="EQ":3,1:"")
+29 ;Grabbing other descriptive fields in 513.72
DO DESC^QANCNV3
+30 ;Responsible Service
IF $DATA(^PRMQ(513.72,PRMQIEN,6))
DO SERV^QANCNV2
+31 SET QANPAT=+$PIECE(PRMQ0,U,2)
SET QANNODE("PAT")=$GET(^DPT(QANPAT,0))
+32 if QANNODE("PAT")']""
SET QANXIT=1
if QANXIT
XECUTE QANMSSG
if QANXIT
QUIT
+33 ;QANPAT("NAME") Patient's name
SET QANPAT("NAME")=$PIECE(QANNODE("PAT"),U)
+34 SET QANPAT("SSN")=$PIECE(QANNODE("PAT"),U,9)
+35 if QANPAT("SSN")]""
SET QANPAT("PT SSN")=$EXTRACT(QANPAT("SSN"),6,9)
+36 SET QANPAT("PT NAME")=$EXTRACT($PIECE(QANPAT("NAME"),",",2))_$EXTRACT($PIECE(QANPAT("NAME")," ",2))_$EXTRACT(QANPAT("NAME"))
+37 ;Builds Patient ID
IF QANPAT("PT NAME")]""
IF QANPAT("PT SSN")]""
SET QANPID=QANPAT("PT NAME")_QANPAT("PT SSN")
+38 SET QANPTY=$SELECT($PIECE(PRMQ0,U,8)="IN":1,$PIECE(PRMQ0,U,8)="OU"!($PIECE(PRMQ0,U,8)="MI"):0,1:"")
+39 ;Find ward, map 42 -> 44
SET QANWARD=+$PIECE(PRMQ0,U,9)
SET QANWARD=$GET(^DIC(42,QANWARD,44))
+40 SET QANSLEV=$SELECT($PIECE(PRMQ0,U,16)="MIT":1,$PIECE(PRMQ0,U,16)="MIP":2,$PIECE(PRMQ0,U,16)="MAT":2,$PIECE(PRMQ0,U,16)="MAP":2,$PIECE(PRMQ0,U,16)="POT":2,$PIECE(PRMQ0,U,16)="DEA":3,$PIECE(PRMQ0,U,16)="NO":0,1:"")
+41 QUIT
