APCLVL04 ; IHS/CMI/LAB - SCREEN LOGIC ;
;;2.0;IHS PCC SUITE;**2,4,7**;MAY 14, 2009
;
EDDSEL ;EP - measurements and values
;get measurement type and value range and store as T_U_RANGE
W !,"With this selection item you will be prompted to enter the date range"
W !,"to search for Estimated Date of Delivery. You will then be prompted"
W !,"to select the Type of EDD estimation (LMP, Ultrasound or Clinical"
W !,"Parameters).",!
GETEDD ;
K APCLEDD
EDDDATE ;GET VALUE RANGE
BD ;
W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning EDD Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No date selected. Choose again." K APCLMSR(0) G GETEDD
S APCLBDAT=Y
ED ;get ending date
W ! S DIR(0)="D^"_APCLBDAT_"::EP",DIR("A")="Enter ending EDD Date for Search" S Y=APCLBDAT D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLEDAT=Y
;S APCLEDD(0)=APCLBDAT_":"_APCLEDAT
GETEDD1 ;
W !,"Please choose the type of EDD Determination. You will be given the"
W !,"chance to choose more than one."
S DIR(0)="SO^L:LMP;U:ULTRASOUND;C:CLINICAL PARAMETERS;A:ANY TYPE",DIR("A")="Select EDD Types",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT),'$D(APCLEDD) W !,"No Types Selected. EDD not used as a selection item." K APCLEDD Q
I Y="A" F X="U","L","C" S APCLEDD(X)=APCLBDAT_U_APCLEDAT G SETRPT
;
SETRPT ;
S (X,Y)=0 F S X=$O(APCLEDD(X)) Q:X'=+X D
.S Y=Y+1
.S ^APCLVRPT(APCLRPT,11,APCLCRIT,0)=APCLCRIT,^APCLVRPT(APCLRPT,11,"B",APCLCRIT,APCLCRIT)=""
.S ^APCLVRPT(APCLRPT,11,APCLCRIT,11,Y,0)=X_"^"_APCLEDD(X)
.S ^APCLVRPT(APCLRPT,11,APCLCRIT,11,"B",X,Y)=""
.S ^APCLVRPT(APCLRPT,11,APCLCRIT,11,0)="^9001003.8110101A^"_Y_"^"_Y
Q
EDDSCR ;EP - CALLED FROM EDD (ALL TYPES)
;S X(1)="" IF ANY ARE IN DATE RANGE
Q:'$D(^AUPNREP(DFN,0))
NEW G,Y,B,E,D
S APCLSPEC=""
S G=0
K X
S Y=$O(^APCLVRPT(APCLRPT,11,APCLI,11,0))
S B=$P(^APCLVRPT(APCLRPT,11,APCLI,11,Y,0),U),E=$P(^APCLVRPT(APCLRPT,11,APCLI,11,Y,0),U,2)
S D=$P($G(^AUPNREP(DFN,13)),U,2) D EDDCD I G S X(1)="",X=1 Q
S D=$P($G(^AUPNREP(DFN,13)),U,5) D EDDCD I G S X(1)="",X=1 Q
S D=$P($G(^AUPNREP(DFN,13)),U,8) D EDDCD I G S X(1)="",X=1 Q
S D=$P($G(^AUPNREP(DFN,13)),U,14) D EDDCD I G S X(1)="",X=1 Q
S D=$P($G(^AUPNREP(DFN,13)),U,11) D EDDCD I G S X(1)="",X=1 Q
Q
EDDCD ;
Q:D<B
Q:D>E
S G=1
Q
;
EDDAPRT ;EP
;GET ALL EDD'S FOR PRINTING
NEW C,D
S C=0
S D=$P($G(^AUPNREP(DFN,13)),U,2) I D S C=C+1,APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY LMP)"
S D=$P($G(^AUPNREP(DFN,13)),U,5) I D S C=C+1,APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY ULTRASOUND)"
S D=$P($G(^AUPNREP(DFN,13)),U,8) I D S C=C+1,APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY CLINICAL PARAMETERS)"
S D=$P($G(^AUPNREP(DFN,13)),U,14) I D S C=C+1,APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY UNKNOWN METHOD)"
S D=$P($G(^AUPNREP(DFN,13)),U,11) I D S C=C+1,APCLPRNM(C)=$$DATE^APCLVLU(D)_" (DEFINITIVE EDD)"
Q
EDDSORT ;EP
;get earliest one for this patient
NEW C,E,D
S C=0,E=""
S D=$P($G(^AUPNREP(DFN,13)),U,2) I D S E=D
S D=$P($G(^AUPNREP(DFN,13)),U,5) I D,D<E S E=D
S D=$P($G(^AUPNREP(DFN,13)),U,8) I D,D<E S E=D
S D=$P($G(^AUPNREP(DFN,13)),U,14) I D,D<E S E=D
S APCLPRNT=E
Q
CMPRT ;EP - called from pgen item
NEW A,B,C,D,E
S (A,B,C,D,E)=""
S A=0 F S A=$O(^AUPNREP(DFN,2101,A)) Q:A'=+A D
.S B=$P(^AUPNREP(DFN,2101,A,0),U,1)
.S B=$P(^AUTTCM(B,0),U,1)
.I B="OTHER" S B=B_$S($P(^AUPNREP(DFN,2101,A,0),U,6)]"":"-"_$P(^AUPNREP(DFN,2101,A,0),U,6),1:"")
.S D=$$DATE^APCLVLU1($P(^AUPNREP(DFN,2101,A,0),U,2))
.S E=$$DATE^APCLVLU1($P(^AUPNREP(DFN,2101,A,0),U,3))
.S C="",C=B_" "_D_"/"_E
.S APCLPCNT=APCLPCNT+1
.S APCLPRNM(APCLPCNT)=C
.Q
Q
APCLVL04 ; IHS/CMI/LAB - SCREEN LOGIC ;
+1 ;;2.0;IHS PCC SUITE;**2,4,7**;MAY 14, 2009
+2 ;
EDDSEL ;EP - measurements and values
+1 ;get measurement type and value range and store as T_U_RANGE
+2 WRITE !,"With this selection item you will be prompted to enter the date range"
+3 WRITE !,"to search for Estimated Date of Delivery. You will then be prompted"
+4 WRITE !,"to select the Type of EDD estimation (LMP, Ultrasound or Clinical"
+5 WRITE !,"Parameters).",!
GETEDD ;
+1 KILL APCLEDD
EDDDATE ;GET VALUE RANGE
BD ;
+1 WRITE !
SET DIR(0)="D^::EP"
SET DIR("A")="Enter beginning EDD Date for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No date selected. Choose again."
KILL APCLMSR(0)
GOTO GETEDD
+3 SET APCLBDAT=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_APCLBDAT_"::EP"
SET DIR("A")="Enter ending EDD Date for Search"
SET Y=APCLBDAT
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLEDAT=Y
+4 ;S APCLEDD(0)=APCLBDAT_":"_APCLEDAT
GETEDD1 ;
+1 WRITE !,"Please choose the type of EDD Determination. You will be given the"
+2 WRITE !,"chance to choose more than one."
+3 SET DIR(0)="SO^L:LMP;U:ULTRASOUND;C:CLINICAL PARAMETERS;A:ANY TYPE"
SET DIR("A")="Select EDD Types"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
IF '$DATA(APCLEDD)
WRITE !,"No Types Selected. EDD not used as a selection item."
KILL APCLEDD
QUIT
+5 IF Y="A"
FOR X="U","L","C"
SET APCLEDD(X)=APCLBDAT_U_APCLEDAT
GOTO SETRPT
+6 ;
SETRPT ;
+1 SET (X,Y)=0
FOR
SET X=$ORDER(APCLEDD(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET Y=Y+1
+3 SET ^APCLVRPT(APCLRPT,11,APCLCRIT,0)=APCLCRIT
SET ^APCLVRPT(APCLRPT,11,"B",APCLCRIT,APCLCRIT)=""
+4 SET ^APCLVRPT(APCLRPT,11,APCLCRIT,11,Y,0)=X_"^"_APCLEDD(X)
+5 SET ^APCLVRPT(APCLRPT,11,APCLCRIT,11,"B",X,Y)=""
+6 SET ^APCLVRPT(APCLRPT,11,APCLCRIT,11,0)="^9001003.8110101A^"_Y_"^"_Y
End DoDot:1
+7 QUIT
EDDSCR ;EP - CALLED FROM EDD (ALL TYPES)
+1 ;S X(1)="" IF ANY ARE IN DATE RANGE
+2 IF '$DATA(^AUPNREP(DFN,0))
QUIT
+3 NEW G,Y,B,E,D
+4 SET APCLSPEC=""
+5 SET G=0
+6 KILL X
+7 SET Y=$ORDER(^APCLVRPT(APCLRPT,11,APCLI,11,0))
+8 SET B=$PIECE(^APCLVRPT(APCLRPT,11,APCLI,11,Y,0),U)
SET E=$PIECE(^APCLVRPT(APCLRPT,11,APCLI,11,Y,0),U,2)
+9 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,2)
DO EDDCD
IF G
SET X(1)=""
SET X=1
QUIT
+10 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,5)
DO EDDCD
IF G
SET X(1)=""
SET X=1
QUIT
+11 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,8)
DO EDDCD
IF G
SET X(1)=""
SET X=1
QUIT
+12 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,14)
DO EDDCD
IF G
SET X(1)=""
SET X=1
QUIT
+13 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,11)
DO EDDCD
IF G
SET X(1)=""
SET X=1
QUIT
+14 QUIT
EDDCD ;
+1 IF D<B
QUIT
+2 IF D>E
QUIT
+3 SET G=1
+4 QUIT
+5 ;
EDDAPRT ;EP
+1 ;GET ALL EDD'S FOR PRINTING
+2 NEW C,D
+3 SET C=0
+4 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,2)
IF D
SET C=C+1
SET APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY LMP)"
+5 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,5)
IF D
SET C=C+1
SET APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY ULTRASOUND)"
+6 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,8)
IF D
SET C=C+1
SET APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY CLINICAL PARAMETERS)"
+7 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,14)
IF D
SET C=C+1
SET APCLPRNM(C)=$$DATE^APCLVLU(D)_" (BY UNKNOWN METHOD)"
+8 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,11)
IF D
SET C=C+1
SET APCLPRNM(C)=$$DATE^APCLVLU(D)_" (DEFINITIVE EDD)"
+9 QUIT
EDDSORT ;EP
+1 ;get earliest one for this patient
+2 NEW C,E,D
+3 SET C=0
SET E=""
+4 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,2)
IF D
SET E=D
+5 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,5)
IF D
IF D<E
SET E=D
+6 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,8)
IF D
IF D<E
SET E=D
+7 SET D=$PIECE($GET(^AUPNREP(DFN,13)),U,14)
IF D
IF D<E
SET E=D
+8 SET APCLPRNT=E
+9 QUIT
CMPRT ;EP - called from pgen item
+1 NEW A,B,C,D,E
+2 SET (A,B,C,D,E)=""
+3 SET A=0
FOR
SET A=$ORDER(^AUPNREP(DFN,2101,A))
IF A'=+A
QUIT
Begin DoDot:1
+4 SET B=$PIECE(^AUPNREP(DFN,2101,A,0),U,1)
+5 SET B=$PIECE(^AUTTCM(B,0),U,1)
+6 IF B="OTHER"
SET B=B_$SELECT($PIECE(^AUPNREP(DFN,2101,A,0),U,6)]"":"-"_$PIECE(^AUPNREP(DFN,2101,A,0),U,6),1:"")
+7 SET D=$$DATE^APCLVLU1($PIECE(^AUPNREP(DFN,2101,A,0),U,2))
+8 SET E=$$DATE^APCLVLU1($PIECE(^AUPNREP(DFN,2101,A,0),U,3))
+9 SET C=""
SET C=B_" "_D_"/"_E
+10 SET APCLPCNT=APCLPCNT+1
+11 SET APCLPRNM(APCLPCNT)=C
+12 QUIT
End DoDot:1
+13 QUIT
