QAMC22 ;HISC/DAD-CONDITION: PTF ICD DIAGNOSIS & PROCEDURE ;7/23/93 10:16
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
S ICDDIAG=+$G(^QA(743,QAMD0,"COND",QAMD1,"P1"))
S ICDPROC=+$G(^QA(743,QAMD0,"COND",QAMD1,"P2"))
F QAMPTFDT=(QAMTODAY-.0000001):0 S QAMPTFDT=$O(^DGP(45.84,"AC",QAMPTFDT)) Q:(QAMPTFDT'>0)!(QAMPTFDT>(QAMTODAY+.9999999))!(QAMPTFDT\1'?7N) F QAMPTFD0=0:0 S QAMPTFD0=$O(^DGP(45.84,"AC",QAMPTFDT,QAMPTFD0)) Q:QAMPTFD0'>0 D LOOP
K ICDDIAG,ICDPROC,OPCODE,PTFDATE,QAMPTF70,QAMPTFD0,QAMPTFD1,QAMPTFDT
Q
LOOP Q:$D(^DGPT(QAMPTFD0,0))[0 S X=^(0),QAMDFN=+X,PTFDATE=$P(X,"^",2),ICDDIAG(0)=0
DIAG S QAMPTF70=$G(^DGPT(QAMPTFD0,70)) F QA=10,16:1:24 S X=+$P(QAMPTF70,"^",QA) I $O(^QA(743.5,ICDDIAG,"GRP","AB",X,0)) S ICDDIAG(0)=1 Q
S:ICDDIAG'>0 ICDDIAG(0)=1 Q:ICDDIAG(0)'>0 I ICDPROC'>0 D FALLOUT Q
PROC F QAMPTFD1=0:0 S QAMPTFD1=$O(^DGPT(QAMPTFD0,"S",QAMPTFD1)) Q:QAMPTFD1'>0 S X=^(QAMPTFD1,0),PTFDATE=+X F QA=8:1:12 S OPCODE=+$P(X,"^",QA) I $O(^QA(743.5,ICDPROC,"GRP","AB",OPCODE,0)) D FALLOUT Q
Q
FALLOUT S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)="",^(QAMDFN,PTFDATE)=QAMPTFD0
Q
EN2 ; *** PARAMETER CODE
21 K DIC,DIR,DIRUT S DIC=743.5,DIC(0)="EMNQZ",DIC("S")="I $P(^(0),""^"",2)=80",DIC("A")="ICD DIAGNOSIS GROUP: ",DIC("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:$P(^("P1"),"^",2),1:"") K:DIC("B")="" DIC("B")
S DIR("?",1)="Enter a GROUP name that contains ICD diagnoses.",DIR("?")="press 'RETURN' for all ICD diagnoses."
S QAMPARAM="P1" D EN2^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)
22 K DIC,DIR,DIRUT S DIC=743.5,DIC(0)="EMNQZ",DIC("S")="I $P(^(0),""^"",2)=80.1",DIC("A")="ICD PROCEDURE GROUP: ",DIC("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:$P(^("P2"),"^",2),1:"") K:DIC("B")="" DIC("B")
S DIR("?",1)="Enter a GROUP name that contains ICD procedures.",DIR("?")="press 'RETURN' for all ICD procedures."
S QAMPARAM="P2" D EN2^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P2")=+Y_"^"_Y(0,0)
EXIT K Y
K QAMPARAM
Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMC22 2066 printed Dec 13, 2024@01:42:06 Page 2
QAMC22 ;HISC/DAD-CONDITION: PTF ICD DIAGNOSIS & PROCEDURE ;7/23/93 10:16
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
+1 SET ICDDIAG=+$GET(^QA(743,QAMD0,"COND",QAMD1,"P1"))
+2 SET ICDPROC=+$GET(^QA(743,QAMD0,"COND",QAMD1,"P2"))
+3 FOR QAMPTFDT=(QAMTODAY-.0000001):0
SET QAMPTFDT=$ORDER(^DGP(45.84,"AC",QAMPTFDT))
if (QAMPTFDT'>0)!(QAMPTFDT>(QAMTODAY+.9999999))!(QAMPTFDT\1'?7N)
QUIT
FOR QAMPTFD0=0:0
SET QAMPTFD0=$ORDER(^DGP(45.84,"AC",QAMPTFDT,QAMPTFD0))
if QAMPTFD0'>0
QUIT
DO LOOP
+4 KILL ICDDIAG,ICDPROC,OPCODE,PTFDATE,QAMPTF70,QAMPTFD0,QAMPTFD1,QAMPTFDT
+5 QUIT
LOOP if $DATA(^DGPT(QAMPTFD0,0))[0
QUIT
SET X=^(0)
SET QAMDFN=+X
SET PTFDATE=$PIECE(X,"^",2)
SET ICDDIAG(0)=0
DIAG SET QAMPTF70=$GET(^DGPT(QAMPTFD0,70))
FOR QA=10,16:1:24
SET X=+$PIECE(QAMPTF70,"^",QA)
IF $ORDER(^QA(743.5,ICDDIAG,"GRP","AB",X,0))
SET ICDDIAG(0)=1
QUIT
+1 if ICDDIAG'>0
SET ICDDIAG(0)=1
if ICDDIAG(0)'>0
QUIT
IF ICDPROC'>0
DO FALLOUT
QUIT
PROC FOR QAMPTFD1=0:0
SET QAMPTFD1=$ORDER(^DGPT(QAMPTFD0,"S",QAMPTFD1))
if QAMPTFD1'>0
QUIT
SET X=^(QAMPTFD1,0)
SET PTFDATE=+X
FOR QA=8:1:12
SET OPCODE=+$PIECE(X,"^",QA)
IF $ORDER(^QA(743.5,ICDPROC,"GRP","AB",OPCODE,0))
DO FALLOUT
QUIT
+1 QUIT
FALLOUT SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAMDFN)=""
SET ^(QAMDFN,PTFDATE)=QAMPTFD0
+1 QUIT
EN2 ; *** PARAMETER CODE
21 KILL DIC,DIR,DIRUT
SET DIC=743.5
SET DIC(0)="EMNQZ"
SET DIC("S")="I $P(^(0),""^"",2)=80"
SET DIC("A")="ICD DIAGNOSIS GROUP: "
SET DIC("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:$PIECE(^("P1"),"^",2),1:"")
if DIC("B")=""
KILL DIC("B")
+1 SET DIR("?",1)="Enter a GROUP name that contains ICD diagnoses."
SET DIR("?")="press 'RETURN' for all ICD diagnoses."
+2 SET QAMPARAM="P1"
DO EN2^QAMUTL1
IF $DATA(DIRUT)
SET Y=-1
GOTO Y
+3 if Y]""
SET ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)
22 KILL DIC,DIR,DIRUT
SET DIC=743.5
SET DIC(0)="EMNQZ"
SET DIC("S")="I $P(^(0),""^"",2)=80.1"
SET DIC("A")="ICD PROCEDURE GROUP: "
SET DIC("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:$PIECE(^("P2"),"^",2),1:"")
if DIC("B")=""
KILL DIC("B")
+1 SET DIR("?",1)="Enter a GROUP name that contains ICD procedures."
SET DIR("?")="press 'RETURN' for all ICD procedures."
+2 SET QAMPARAM="P2"
DO EN2^QAMUTL1
IF $DATA(DIRUT)
SET Y=-1
GOTO Y
+3 if Y]""
SET ^QA(743,QAMD0,"COND",QAMD1,"P2")=+Y_"^"_Y(0,0)
EXIT KILL Y
+1 KILL QAMPARAM
Y QUIT
