- 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
