GMTSWVC1 ;ISP/RFR - WOMEN'S HEALTH HEALTH SUMMARY COMPONENTS;Dec 13, 2019@09:00
;;2.7;Health Summary;**67**;Oct 20, 1995;Build 538
Q
ALL ;DISPLAY PREGNANCY AND LACTATION STATUS DOCUMENTATION
D DOCDIS("P")
W !
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
D CKP^GMTSUP Q:$D(GMTSQIT)
D DOCDIS("L")
Q
PDOC ;DISPLAY PREGNANCY STATUS DOCUMENTATION
D DOCDIS("P")
Q
LDOC ;DISPLAY LACTATION STATUS DOCUMENTATION
D DOCDIS("L")
Q
DOCDIS(GMTSTYPE) ;DISPLAY PREGNANCY OR LACATION STATUS DOCUMENTATION
;INPUT: GMTSTYPE - TYPE OF DOCUMENTATION TO DISPLAY [REQUIRED]
; "P" FOR PREGNANCY
; "L" FOR LACTATION
Q:"^P^L^"'[U_$G(GMTSTYPE)_U
N GMTSIDX,WHTYPES
S WHTYPES("P")="PREGNANCY STATUS"_U_"PREGNANCY STATE"
S WHTYPES("L")="LACTATION STATUS"_U_"LACTATION STATE"
D GETDATA^WVRPCPT("GMTSWHPL",DFN,GMTSTYPE,GMTSBEG,GMTSEND,$S(GMTSNDM>-1:GMTSNDM,1:""))
G:$G(^TMP("GMTSWHPL",$J))=0 EXIT
I $P($G(^TMP("GMTSWHPL",$J)),U)=-1 D G EXIT
.D CKP^GMTSUP Q:$D(GMTSQIT)
.N ERROR
.S ERROR=$P($G(^TMP("GMTSWHPL",$J)),U,2)
.I ERROR="The specified patient is not in the WV PATIENT file" W "No data on file",! Q
.W "Error retrieving data:",!
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W ERROR,!
D HDR
S GMTSIDX=0 F S GMTSIDX=$O(^TMP("GMTSWHPL",$J,GMTSIDX)) Q:'GMTSIDX!($D(GMTSQIT)) D
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,$P(WHTYPES(GMTSTYPE),U)_" D/T ENTERED")),U,2)
.W ?23,$P($G(^TMP("GMTSWHPL",$J,GMTSIDX,$P(WHTYPES(GMTSTYPE),U,2))),U,2),!
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.I GMTSTYPE="P" D PREG
.I GMTSTYPE="L" D LAC
EXIT ;CLEAN-UP AND QUIT
K:$D(^TMP("GMTSWHPL",$J)) ^TMP("GMTSWHPL",$J)
K:$D(^TMP("GMTSWHSMRT",$J)) ^TMP("GMTSWHSMRT",$J)
Q
HDR ;OUTPUT THE HEADER
D CKP^GMTSUP Q:$D(GMTSQIT)
W "DATE",?23,$P(WHTYPES(GMTSTYPE),U,2),!
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?2,"DETAILS",!
D CKP^GMTSUP Q:$D(GMTSQIT)
W $$REPEAT^XLFSTR("=",50),!
Q
LAC ;OUTPUT LACTATION STATUS DETAILS
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"END DATE")) D Q:$D(GMTSQIT)
.W ?2,"DATE PATIENT STOPPED LACTATING: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"END DATE")),U,2),!
Q
PREG ;OUTPUT PREGNANCY STATUS DETAILS
I $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,$P(WHTYPES(GMTSTYPE),U))),U,2)'="PREGNANT" D
.W ?2,"MEDICALLY UNABLE TO CONCEIVE: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"MEDICALLY UNABLE TO CONCEIVE")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"MEDICAL REASON")) D Q
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"MEDICAL REASON: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"MEDICAL REASON")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"TRYING TO BECOME PREGNANT")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"TRYING TO BECOME PREGNANT: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"TRYING TO BECOME PREGNANT")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"CONTRACEPTIVE METHOD USED")) D Q:$D(GMTSQIT)
.N GMTSCMIX,GMTSSHDR
.S GMTSCMIX=0 F S GMTSCMIX=$O(^TMP("GMTSWHPL",$J,GMTSIDX,"CONTRACEPTIVE METHOD USED",GMTSCMIX)) Q:'GMTSCMIX!($D(GMTSQIT)) D
..D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
..I '$G(GMTSSHDR) D
...W ?2,"CONTRACEPTIVE METHOD(S) USED: "
...S GMTSSHDR=1
..W ?32,$P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"CONTRACEPTIVE METHOD USED",GMTSCMIX)),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"PREGNANCY LIKELIHOOD")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"LIKELIHOOD OF BECOMING PREGNANT: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"PREGNANCY LIKELIHOOD")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"LAST MENSTRUAL PERIOD DATE")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"LAST MENSTRUAL PERIOD DATE: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"LAST MENSTRUAL PERIOD DATE")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"EDD")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"EXPECTED DUE DATE: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"EDD")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"OVERRIDE CALCULATED EDD REASON")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"REASON WHY CALCULATED EDD WAS OVERRIDDEN: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"OVERRIDE CALCULATED EDD REASON")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"PREGNANCY END DATE")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"PREGNANCY END DATE: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"PREGNANCY END DATE")),U,2),!
I $D(^TMP("GMTSWHPL",$J,GMTSIDX,"REASON PREGNANCY ENDED")) D Q:$D(GMTSQIT)
.D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
.W ?2,"REASON PREGNANCY ENDED: "
.W $P($G(^TMP("GMTSWHPL",$J,GMTSIDX,"REASON PREGNANCY ENDED")),U,2),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSWVC1 4670 printed Dec 13, 2024@02:00:43 Page 2
GMTSWVC1 ;ISP/RFR - WOMEN'S HEALTH HEALTH SUMMARY COMPONENTS;Dec 13, 2019@09:00
+1 ;;2.7;Health Summary;**67**;Oct 20, 1995;Build 538
+2 QUIT
ALL ;DISPLAY PREGNANCY AND LACTATION STATUS DOCUMENTATION
+1 DO DOCDIS("P")
+2 WRITE !
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE !
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 DO DOCDIS("L")
+7 QUIT
PDOC ;DISPLAY PREGNANCY STATUS DOCUMENTATION
+1 DO DOCDIS("P")
+2 QUIT
LDOC ;DISPLAY LACTATION STATUS DOCUMENTATION
+1 DO DOCDIS("L")
+2 QUIT
DOCDIS(GMTSTYPE) ;DISPLAY PREGNANCY OR LACATION STATUS DOCUMENTATION
+1 ;INPUT: GMTSTYPE - TYPE OF DOCUMENTATION TO DISPLAY [REQUIRED]
+2 ; "P" FOR PREGNANCY
+3 ; "L" FOR LACTATION
+4 if "^P^L^"'[U_$GET(GMTSTYPE)_U
QUIT
+5 NEW GMTSIDX,WHTYPES
+6 SET WHTYPES("P")="PREGNANCY STATUS"_U_"PREGNANCY STATE"
+7 SET WHTYPES("L")="LACTATION STATUS"_U_"LACTATION STATE"
+8 DO GETDATA^WVRPCPT("GMTSWHPL",DFN,GMTSTYPE,GMTSBEG,GMTSEND,$SELECT(GMTSNDM>-1:GMTSNDM,1:""))
+9 if $GET(^TMP("GMTSWHPL",$JOB))=0
GOTO EXIT
+10 IF $PIECE($GET(^TMP("GMTSWHPL",$JOB)),U)=-1
Begin DoDot:1
+11 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+12 NEW ERROR
+13 SET ERROR=$PIECE($GET(^TMP("GMTSWHPL",$JOB)),U,2)
+14 IF ERROR="The specified patient is not in the WV PATIENT file"
WRITE "No data on file",!
QUIT
+15 WRITE "Error retrieving data:",!
+16 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+17 WRITE ERROR,!
End DoDot:1
GOTO EXIT
+18 DO HDR
+19 SET GMTSIDX=0
FOR
SET GMTSIDX=$ORDER(^TMP("GMTSWHPL",$JOB,GMTSIDX))
if 'GMTSIDX!($DATA(GMTSQIT))
QUIT
Begin DoDot:1
+20 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+21 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,$PIECE(WHTYPES(GMTSTYPE),U)_" D/T ENTERED")),U,2)
+22 WRITE ?23,$PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,$PIECE(WHTYPES(GMTSTYPE),U,2))),U,2),!
+23 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+24 IF GMTSTYPE="P"
DO PREG
+25 IF GMTSTYPE="L"
DO LAC
End DoDot:1
EXIT ;CLEAN-UP AND QUIT
+1 if $DATA(^TMP("GMTSWHPL",$JOB))
KILL ^TMP("GMTSWHPL",$JOB)
+2 if $DATA(^TMP("GMTSWHSMRT",$JOB))
KILL ^TMP("GMTSWHSMRT",$JOB)
+3 QUIT
HDR ;OUTPUT THE HEADER
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE "DATE",?23,$PIECE(WHTYPES(GMTSTYPE),U,2),!
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE ?2,"DETAILS",!
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE $$REPEAT^XLFSTR("=",50),!
+7 QUIT
LAC ;OUTPUT LACTATION STATUS DETAILS
+1 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"END DATE"))
Begin DoDot:1
+2 WRITE ?2,"DATE PATIENT STOPPED LACTATING: "
+3 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"END DATE")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 QUIT
PREG ;OUTPUT PREGNANCY STATUS DETAILS
+1 IF $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,$PIECE(WHTYPES(GMTSTYPE),U))),U,2)'="PREGNANT"
Begin DoDot:1
+2 WRITE ?2,"MEDICALLY UNABLE TO CONCEIVE: "
+3 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"MEDICALLY UNABLE TO CONCEIVE")),U,2),!
End DoDot:1
+4 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"MEDICAL REASON"))
Begin DoDot:1
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+6 WRITE ?2,"MEDICAL REASON: "
+7 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"MEDICAL REASON")),U,2),!
End DoDot:1
QUIT
+8 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"TRYING TO BECOME PREGNANT"))
Begin DoDot:1
+9 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+10 WRITE ?2,"TRYING TO BECOME PREGNANT: "
+11 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"TRYING TO BECOME PREGNANT")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+12 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"CONTRACEPTIVE METHOD USED"))
Begin DoDot:1
+13 NEW GMTSCMIX,GMTSSHDR
+14 SET GMTSCMIX=0
FOR
SET GMTSCMIX=$ORDER(^TMP("GMTSWHPL",$JOB,GMTSIDX,"CONTRACEPTIVE METHOD USED",GMTSCMIX))
if 'GMTSCMIX!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+16 IF '$GET(GMTSSHDR)
Begin DoDot:3
+17 WRITE ?2,"CONTRACEPTIVE METHOD(S) USED: "
+18 SET GMTSSHDR=1
End DoDot:3
+19 WRITE ?32,$PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"CONTRACEPTIVE METHOD USED",GMTSCMIX)),U,2),!
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+20 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"PREGNANCY LIKELIHOOD"))
Begin DoDot:1
+21 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+22 WRITE ?2,"LIKELIHOOD OF BECOMING PREGNANT: "
+23 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"PREGNANCY LIKELIHOOD")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+24 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"LAST MENSTRUAL PERIOD DATE"))
Begin DoDot:1
+25 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+26 WRITE ?2,"LAST MENSTRUAL PERIOD DATE: "
+27 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"LAST MENSTRUAL PERIOD DATE")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+28 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"EDD"))
Begin DoDot:1
+29 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+30 WRITE ?2,"EXPECTED DUE DATE: "
+31 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"EDD")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+32 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"OVERRIDE CALCULATED EDD REASON"))
Begin DoDot:1
+33 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+34 WRITE ?2,"REASON WHY CALCULATED EDD WAS OVERRIDDEN: "
+35 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"OVERRIDE CALCULATED EDD REASON")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+36 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"PREGNANCY END DATE"))
Begin DoDot:1
+37 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+38 WRITE ?2,"PREGNANCY END DATE: "
+39 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"PREGNANCY END DATE")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+40 IF $DATA(^TMP("GMTSWHPL",$JOB,GMTSIDX,"REASON PREGNANCY ENDED"))
Begin DoDot:1
+41 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+42 WRITE ?2,"REASON PREGNANCY ENDED: "
+43 WRITE $PIECE($GET(^TMP("GMTSWHPL",$JOB,GMTSIDX,"REASON PREGNANCY ENDED")),U,2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+44 QUIT
