WVMGRP ;HCIOFO/FT,JR - MANAGER'S PATIENT EDITS;06/14/2017  08:56
 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
 ;;IHS/ANMC/MWR * MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG
 ;;  AND PREGNANCY/LACTATION STATUS DATA.
 ;
PLOG ;EP
 ;---> CALLED BY OPTION: "WV EDIT PAP REGIMEN LOG".
 D SETVARS^WVUTL5
 N A,DR,Y
 F  D  Q:$G(Y)<0
 .D TITLE^WVUTL5("EDIT PAP REGIMEN LOG")
 .D PLOGTX W !
 .S A="   Select PATIENT (or Enter a new BEGIN DATE): "
 .D DIC^WVFMAN(790.04,"QEMAL",.Y,A)
 .Q:Y<0  K WVJR
 .I $P($G(^WV(790.04,+Y,0)),U,2)="" N DIK S WVJR=+Y,DIK="^WV(790.04," D DEL Q
 .D NAME("^WV(790.04,",+Y)
 .S DR=".01;.03"
 .D DIE^WVFMAN(790.04,DR,+Y,.WVPOP)
 .S:WVPOP Y=-1
 .Q
 K WVJR
 D EXIT
 Q
DEL ; Delete File 790.04 entry if no patient
 S DA=WVJR D ^DIK
 W !!?10,"****  Patient Name Required  ---  Entry Deleted  ****",!!
 D DIRZ^WVUTL3 Q
 ;
PLOGTX ;EP
 ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN
 ;;         Log, be SURE that another entry with the same "BEGIN DATE:"
 ;;         does not already exist for this patient.
 ;;
 ;;         (Ordinarily, the program checks this and will not allow
 ;;         two separate entries for the same patient on the same
 ;;         "BEGIN DATE:".  But under this option you, as the Manager,
 ;;         have greater edit capability.)
 S WVTAB=5,WVLINL="PLOGTX" D PRINTX
 Q
 ;
 ;
PLSDATA ;EDIT PREGNANCY/LACTATION STATUS DATA
 ;---> CALLED BY OPTION: "WV EDIT PREG/LAC STATUS DATA".
 D SETVARS^WVUTL5
 N A,Y,DIK,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT,WVPAT
 F  D  Q:$G(Y)=-1!($D(XQAID))
 .D TITLE^WVUTL5("EDIT PREGNANCY/LACTATION STATUS DATA")
 .I '$D(XQAID) D
 ..S A="   Select PATIENT: "
 ..D DIC^WVFMAN(790,"QEMA",.Y,A,,"I $O(^WV(790.8,""B"",Y,0))'=""""!($$NUMRECS^WVMGRP(Y)>0)")
 ..I +$G(Y)<1 S Y=-1,WVPAT=0 Q
 ..K WVJR,DA
 ..S WVPAT=+Y
 ..W !
 .I $D(XQAID) S WVPAT=+$P(XQAID,",",2)
 .Q:'WVPAT
 .S WVPAT("NAME")=$$EXTERNAL^DILFD(790,.01,"",WVPAT)
 .I $O(^WV(790.8,"B",WVPAT,0))'="" D  Q
 ..D DOCACT^WVMGRP1
 ..I $O(^WV(790.8,"B",WVPAT,0))="" D
 ...N XQAID,XQAKILL
 ...S XQAID="WV,"_WVPAT_",1"
 ...D DELETEA^XQALERT
 .I $D(XQAID),$O(^WV(790.8,"B",WVPAT,0))="" W "There are no status review records for "_WVPAT("NAME")_".",! H 5 Q
 .I $O(^WV(790,WVPAT,4,"B",0))'=""!($O(^WV(790,WVPAT,5,"B",0))'="") D MANAGE Q
 .W "There are no status records for "_WVPAT("NAME")_".",! H 5 Q
 I $D(XQAID) D
 .I $O(^WV(790.8,"B",WVPAT,0))'="" K XQAKILL
 .E  S XQAKILL=0
 D EXIT
 Q
MANAGE ;MANAGE STATUS DATA INDIVIDUALLY
 N WVDIRP2,WVNODE,WVGOTIT,WVDATE,WVIEN,WVENTS,WVEXIT,WVPROMPT,WVRETURN
 S WVNODE(4)="Pregnancy"_U_790.05,WVNODE(5)="Lactation"_U_790.16
 S WVNODE=0 F  S WVNODE=$O(WVNODE(WVNODE)) Q:'+WVNODE  D
 .S WVDATE=0 F  S WVDATE=$O(^WV(790,WVPAT,WVNODE,"B",WVDATE)) Q:'+WVDATE!($G(WVDIRP2(1)))  S WVIEN=0 F  S WVIEN=$O(^WV(790,WVPAT,WVNODE,"B",WVDATE,WVIEN)) Q:'+WVIEN!($G(WVDIRP2(1)))  D
 ..Q:$P($G(^WV(790,WVPAT,WVNODE,WVIEN,0)),U,6)
 ..S WVENTS(WVNODE)=1+$G(WVENTS(WVNODE)),WVENTS=WVENTS(WVNODE),WVENTS(WVNODE,WVENTS)=WVIEN_U_$$FMTE^XLFDT(WVDATE)_" => "_$$GET1^DIQ($P(WVNODE(WVNODE),U,2),WVIEN_","_WVPAT_",",21)
 ..S WVDIRP2(1)=$E(WVNODE(WVNODE),1)_":"_$P(WVNODE(WVNODE),U)
 .I $G(WVDIRP2(1))'="" S WVDIRP2=$S($G(WVDIRP2)'="":WVDIRP2_";",1:"")_WVDIRP2(1)
 .I '$D(WVDIRP2(1)) K WVNODE(WVNODE)
 .K WVDIRP2(1)
 I $D(WVNODE)<10 S Y=-2 Q
 I $L(WVDIRP2,";")>1 D  Q:$G(Y)=-1
 .S DIR(0)="S"_U_WVDIRP2,DIR("A")="   Select DATA TYPE"
 .S DIR("?")="Enter the letter to the left of the type of status data you want to work with."
 .D ^DIR
 .I $D(DIRUT)!($D(DIROUT)) S Y=-1 Q
 .W !
 .S WVNODE=0 F  S WVNODE=$O(WVNODE(WVNODE)) Q:'+WVNODE!($G(WVGOTIT))  I $E(WVNODE(WVNODE),1)=Y S WVGOTIT=WVNODE
 .S WVNODE=$G(WVGOTIT)
 I $L(WVDIRP2,";")=1 S WVNODE=$O(WVENTS(0))
 F  Q:$G(WVEXIT)'=""  D
 .I WVENTS(WVNODE)>1 D  Q:$G(WVEXIT)'=""
 ..N WVLINE,END,X
 ..S WVLINE=1
 ..W !,"   The following "_$$LOW^XLFSTR($P(WVNODE(WVNODE),U))_" status data is on file:",!!
 ..S WVENTS=0 F  S WVENTS=$O(WVENTS(WVNODE,WVENTS)) Q:'+WVENTS!($G(END))  D
 ...I WVLINE=($G(IOSL)-2) W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") S:END WVEXIT=-1 Q:END  S WVLINE=1
 ...W ?5,$$RJ^XLFSTR(WVENTS," ",3),?11,$P(WVENTS(WVNODE,WVENTS),U,2),!
 ...S WVLINE=WVLINE+1
 ..S DIR(0)="NO"_U_U_"K:'$D(WVENTS(WVNODE,X)) X",DIR("A")="Select the data you want to work with"
 ..S DIR("?")="Enter the number to the left of the status data you want to work with."
 ..D ^DIR
 ..I $D(DTOUT)!($D(DUOUT)) S WVEXIT=-1 Q
 ..W !
 ..I Y="" S WVEXIT=-2 Q
 ..K DIR
 ..S WVENTS("Y")=Y
 .I WVENTS(WVNODE)=1 S WVENTS("Y")=$O(WVENTS(WVNODE,0))
 .I WVENTS(WVNODE)=0 S WVEXIT=-2 Q
 .S WVRETURN=$$SHODATA^WVMGRP1
 .I WVRETURN=-1 S WVEXIT=WVRETURN Q
 .S DIR(0)="Y"_U,DIR("A")="Do you want to mark this status data as entered in error"
 .S DIR("?",1)="If the status displayed is valid as of the date and time it was entered, enter"
 .S DIR("?",2)="'N' for no (you do not want to mark the status as entered in error). If the"
 .S DIR("?",3)="status was never valid, enter 'Y' for yes (you do want to mark the status as"
 .S DIR("?")="entered in error)."
 .D ^DIR
 .I $D(DIRUT)!($D(DIROUT)) S WVEXIT=-1 Q
 .K DIR
 .I Y D  Q
 ..S WVPROMPT=+WVENTS(WVNODE,WVENTS("Y"))_","_WVPAT_",",WVEXIT=$$PACT^WVMGRP2(WVNODE,2) Q:WVEXIT=-1
 ..S WVENTS(WVNODE)=WVENTS(WVNODE)-1
 ..K WVENTS(WVNODE,WVENTS("Y"))
 ..K WVEXIT
 .I 'Y S WVEXIT=1
 I $G(WVEXIT)'="" S Y=WVEXIT
 Q
 ;
ERROR(ACTION,FMERROR,ERROR) ;DISPLAY ERROR MESSAGE
 N LINE
 W !,"   Error while "_$G(ACTION)_":",!
 I $D(FMERROR)>9 W "   "_$$FMERROR^WVUTL11(.FMERROR),!
 I $D(ERROR)=1 F LINE=1:1:$L(ERROR,U) W "   "_$P(ERROR,U,LINE),!
 W "   Please contact your help desk for assistance.",!!
 H 5
 Q -1
EXIT ;EP
 W @IOF
 D KILLALL^WVUTL8
 Q
 ;
PRINTX ;EP
 ;---> PRINTS TEXT.
 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
 Q
 ;
NAME(DIC,Y) ;EP
 N WVDFN
 I DIC="^WV(790," S WVDFN=Y
 E  S WVDFN=$P(@(DIC_Y_",0)"),U,2)
 W !!?3,$$NAME^WVUTL1(WVDFN),"   ",$$SSN^WVUTL1(WVDFN),!
 Q
 ;
 ;
NONE ;EP
 S WVTITLE="* There are no PAP Regimen Log entries for this patient. *"
 D CENTERT^WVUTL5(.WVTITLE)
 W !!!!,WVTITLE,!!
 D DIRZ^WVUTL3
 Q
NUMRECS(DFN) ;RETURN THE NUMBER OF PREGNANCY AND LACTATION RECORDS
 N COUNT,NODE,IEN
 S COUNT=0
 F NODE=4,5  S IEN=0 F  S IEN=$O(^WV(790,DFN,NODE,IEN)) Q:'+IEN  D
 .I $P($G(^WV(790,DFN,NODE,IEN,0)),U,6)'=1 S COUNT=COUNT+1
 Q COUNT
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVMGRP   6601     printed  Sep 23, 2025@20:23:32                                                                                                                                                                                                      Page 2
WVMGRP    ;HCIOFO/FT,JR - MANAGER'S PATIENT EDITS;06/14/2017  08:56
 +1       ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
 +2       ;;IHS/ANMC/MWR * MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 +3       ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG
 +4       ;;  AND PREGNANCY/LACTATION STATUS DATA.
 +5       ;
PLOG      ;EP
 +1       ;---> CALLED BY OPTION: "WV EDIT PAP REGIMEN LOG".
 +2        DO SETVARS^WVUTL5
 +3        NEW A,DR,Y
 +4        FOR 
               Begin DoDot:1
 +5                DO TITLE^WVUTL5("EDIT PAP REGIMEN LOG")
 +6                DO PLOGTX
                   WRITE !
 +7                SET A="   Select PATIENT (or Enter a new BEGIN DATE): "
 +8                DO DIC^WVFMAN(790.04,"QEMAL",.Y,A)
 +9                if Y<0
                       QUIT 
                   KILL WVJR
 +10               IF $PIECE($GET(^WV(790.04,+Y,0)),U,2)=""
                       NEW DIK
                       SET WVJR=+Y
                       SET DIK="^WV(790.04,"
                       DO DEL
                       QUIT 
 +11               DO NAME("^WV(790.04,",+Y)
 +12               SET DR=".01;.03"
 +13               DO DIE^WVFMAN(790.04,DR,+Y,.WVPOP)
 +14               if WVPOP
                       SET Y=-1
 +15               QUIT 
               End DoDot:1
               if $GET(Y)<0
                   QUIT 
 +16       KILL WVJR
 +17       DO EXIT
 +18       QUIT 
DEL       ; Delete File 790.04 entry if no patient
 +1        SET DA=WVJR
           DO ^DIK
 +2        WRITE !!?10,"****  Patient Name Required  ---  Entry Deleted  ****",!!
 +3        DO DIRZ^WVUTL3
           QUIT 
 +4       ;
PLOGTX    ;EP
 +1       ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN
 +2       ;;         Log, be SURE that another entry with the same "BEGIN DATE:"
 +3       ;;         does not already exist for this patient.
 +4       ;;
 +5       ;;         (Ordinarily, the program checks this and will not allow
 +6       ;;         two separate entries for the same patient on the same
 +7       ;;         "BEGIN DATE:".  But under this option you, as the Manager,
 +8       ;;         have greater edit capability.)
 +9        SET WVTAB=5
           SET WVLINL="PLOGTX"
           DO PRINTX
 +10       QUIT 
 +11      ;
 +12      ;
PLSDATA   ;EDIT PREGNANCY/LACTATION STATUS DATA
 +1       ;---> CALLED BY OPTION: "WV EDIT PREG/LAC STATUS DATA".
 +2        DO SETVARS^WVUTL5
 +3        NEW A,Y,DIK,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT,WVPAT
 +4        FOR 
               Begin DoDot:1
 +5                DO TITLE^WVUTL5("EDIT PREGNANCY/LACTATION STATUS DATA")
 +6                IF '$DATA(XQAID)
                       Begin DoDot:2
 +7                        SET A="   Select PATIENT: "
 +8                        DO DIC^WVFMAN(790,"QEMA",.Y,A,,"I $O(^WV(790.8,""B"",Y,0))'=""""!($$NUMRECS^WVMGRP(Y)>0)")
 +9                        IF +$GET(Y)<1
                               SET Y=-1
                               SET WVPAT=0
                               QUIT 
 +10                       KILL WVJR,DA
 +11                       SET WVPAT=+Y
 +12                       WRITE !
                       End DoDot:2
 +13               IF $DATA(XQAID)
                       SET WVPAT=+$PIECE(XQAID,",",2)
 +14               if 'WVPAT
                       QUIT 
 +15               SET WVPAT("NAME")=$$EXTERNAL^DILFD(790,.01,"",WVPAT)
 +16               IF $ORDER(^WV(790.8,"B",WVPAT,0))'=""
                       Begin DoDot:2
 +17                       DO DOCACT^WVMGRP1
 +18                       IF $ORDER(^WV(790.8,"B",WVPAT,0))=""
                               Begin DoDot:3
 +19                               NEW XQAID,XQAKILL
 +20                               SET XQAID="WV,"_WVPAT_",1"
 +21                               DO DELETEA^XQALERT
                               End DoDot:3
                       End DoDot:2
                       QUIT 
 +22               IF $DATA(XQAID)
                       IF $ORDER(^WV(790.8,"B",WVPAT,0))=""
                           WRITE "There are no status review records for "_WVPAT("NAME")_".",!
                           HANG 5
                           QUIT 
 +23               IF $ORDER(^WV(790,WVPAT,4,"B",0))'=""!($ORDER(^WV(790,WVPAT,5,"B",0))'="")
                       DO MANAGE
                       QUIT 
 +24               WRITE "There are no status records for "_WVPAT("NAME")_".",!
                   HANG 5
                   QUIT 
               End DoDot:1
               if $GET(Y)=-1!($DATA(XQAID))
                   QUIT 
 +25       IF $DATA(XQAID)
               Begin DoDot:1
 +26               IF $ORDER(^WV(790.8,"B",WVPAT,0))'=""
                       KILL XQAKILL
 +27              IF '$TEST
                       SET XQAKILL=0
               End DoDot:1
 +28       DO EXIT
 +29       QUIT 
MANAGE    ;MANAGE STATUS DATA INDIVIDUALLY
 +1        NEW WVDIRP2,WVNODE,WVGOTIT,WVDATE,WVIEN,WVENTS,WVEXIT,WVPROMPT,WVRETURN
 +2        SET WVNODE(4)="Pregnancy"_U_790.05
           SET WVNODE(5)="Lactation"_U_790.16
 +3        SET WVNODE=0
           FOR 
               SET WVNODE=$ORDER(WVNODE(WVNODE))
               if '+WVNODE
                   QUIT 
               Begin DoDot:1
 +4                SET WVDATE=0
                   FOR 
                       SET WVDATE=$ORDER(^WV(790,WVPAT,WVNODE,"B",WVDATE))
                       if '+WVDATE!($GET(WVDIRP2(1)))
                           QUIT 
                       SET WVIEN=0
                       FOR 
                           SET WVIEN=$ORDER(^WV(790,WVPAT,WVNODE,"B",WVDATE,WVIEN))
                           if '+WVIEN!($GET(WVDIRP2(1)))
                               QUIT 
                           Begin DoDot:2
 +5                            if $PIECE($GET(^WV(790,WVPAT,WVNODE,WVIEN,0)),U,6)
                                   QUIT 
 +6                            SET WVENTS(WVNODE)=1+$GET(WVENTS(WVNODE))
                               SET WVENTS=WVENTS(WVNODE)
                               SET WVENTS(WVNODE,WVENTS)=WVIEN_U_$$FMTE^XLFDT(WVDATE)_" => "_$$GET1^DIQ($PIECE(WVNODE(WVNODE),U,2),WVIEN_","_WVPAT_",",21)
 +7                            SET WVDIRP2(1)=$EXTRACT(WVNODE(WVNODE),1)_":"_$PIECE(WVNODE(WVNODE),U)
                           End DoDot:2
 +8                IF $GET(WVDIRP2(1))'=""
                       SET WVDIRP2=$SELECT($GET(WVDIRP2)'="":WVDIRP2_";",1:"")_WVDIRP2(1)
 +9                IF '$DATA(WVDIRP2(1))
                       KILL WVNODE(WVNODE)
 +10               KILL WVDIRP2(1)
               End DoDot:1
 +11       IF $DATA(WVNODE)<10
               SET Y=-2
               QUIT 
 +12       IF $LENGTH(WVDIRP2,";")>1
               Begin DoDot:1
 +13               SET DIR(0)="S"_U_WVDIRP2
                   SET DIR("A")="   Select DATA TYPE"
 +14               SET DIR("?")="Enter the letter to the left of the type of status data you want to work with."
 +15               DO ^DIR
 +16               IF $DATA(DIRUT)!($DATA(DIROUT))
                       SET Y=-1
                       QUIT 
 +17               WRITE !
 +18               SET WVNODE=0
                   FOR 
                       SET WVNODE=$ORDER(WVNODE(WVNODE))
                       if '+WVNODE!($GET(WVGOTIT))
                           QUIT 
                       IF $EXTRACT(WVNODE(WVNODE),1)=Y
                           SET WVGOTIT=WVNODE
 +19               SET WVNODE=$GET(WVGOTIT)
               End DoDot:1
               if $GET(Y)=-1
                   QUIT 
 +20       IF $LENGTH(WVDIRP2,";")=1
               SET WVNODE=$ORDER(WVENTS(0))
 +21       FOR 
               if $GET(WVEXIT)'=""
                   QUIT 
               Begin DoDot:1
 +22               IF WVENTS(WVNODE)>1
                       Begin DoDot:2
 +23                       NEW WVLINE,END,X
 +24                       SET WVLINE=1
 +25                       WRITE !,"   The following "_$$LOW^XLFSTR($PIECE(WVNODE(WVNODE),U))_" status data is on file:",!!
 +26                       SET WVENTS=0
                           FOR 
                               SET WVENTS=$ORDER(WVENTS(WVNODE,WVENTS))
                               if '+WVENTS!($GET(END))
                                   QUIT 
                               Begin DoDot:3
 +27                               IF WVLINE=($GET(IOSL)-2)
                                       WRITE !,"Press RETURN to continue or '^' to exit: "
                                       READ X:DTIME
                                       SET END='$TEST!(X="^")
                                       if END
                                           SET WVEXIT=-1
                                       if END
                                           QUIT 
                                       SET WVLINE=1
 +28                               WRITE ?5,$$RJ^XLFSTR(WVENTS," ",3),?11,$PIECE(WVENTS(WVNODE,WVENTS),U,2),!
 +29                               SET WVLINE=WVLINE+1
                               End DoDot:3
 +30                       SET DIR(0)="NO"_U_U_"K:'$D(WVENTS(WVNODE,X)) X"
                           SET DIR("A")="Select the data you want to work with"
 +31                       SET DIR("?")="Enter the number to the left of the status data you want to work with."
 +32                       DO ^DIR
 +33                       IF $DATA(DTOUT)!($DATA(DUOUT))
                               SET WVEXIT=-1
                               QUIT 
 +34                       WRITE !
 +35                       IF Y=""
                               SET WVEXIT=-2
                               QUIT 
 +36                       KILL DIR
 +37                       SET WVENTS("Y")=Y
                       End DoDot:2
                       if $GET(WVEXIT)'=""
                           QUIT 
 +38               IF WVENTS(WVNODE)=1
                       SET WVENTS("Y")=$ORDER(WVENTS(WVNODE,0))
 +39               IF WVENTS(WVNODE)=0
                       SET WVEXIT=-2
                       QUIT 
 +40               SET WVRETURN=$$SHODATA^WVMGRP1
 +41               IF WVRETURN=-1
                       SET WVEXIT=WVRETURN
                       QUIT 
 +42               SET DIR(0)="Y"_U
                   SET DIR("A")="Do you want to mark this status data as entered in error"
 +43               SET DIR("?",1)="If the status displayed is valid as of the date and time it was entered, enter"
 +44               SET DIR("?",2)="'N' for no (you do not want to mark the status as entered in error). If the"
 +45               SET DIR("?",3)="status was never valid, enter 'Y' for yes (you do want to mark the status as"
 +46               SET DIR("?")="entered in error)."
 +47               DO ^DIR
 +48               IF $DATA(DIRUT)!($DATA(DIROUT))
                       SET WVEXIT=-1
                       QUIT 
 +49               KILL DIR
 +50               IF Y
                       Begin DoDot:2
 +51                       SET WVPROMPT=+WVENTS(WVNODE,WVENTS("Y"))_","_WVPAT_","
                           SET WVEXIT=$$PACT^WVMGRP2(WVNODE,2)
                           if WVEXIT=-1
                               QUIT 
 +52                       SET WVENTS(WVNODE)=WVENTS(WVNODE)-1
 +53                       KILL WVENTS(WVNODE,WVENTS("Y"))
 +54                       KILL WVEXIT
                       End DoDot:2
                       QUIT 
 +55               IF 'Y
                       SET WVEXIT=1
               End DoDot:1
 +56       IF $GET(WVEXIT)'=""
               SET Y=WVEXIT
 +57       QUIT 
 +58      ;
ERROR(ACTION,FMERROR,ERROR) ;DISPLAY ERROR MESSAGE
 +1        NEW LINE
 +2        WRITE !,"   Error while "_$GET(ACTION)_":",!
 +3        IF $DATA(FMERROR)>9
               WRITE "   "_$$FMERROR^WVUTL11(.FMERROR),!
 +4        IF $DATA(ERROR)=1
               FOR LINE=1:1:$LENGTH(ERROR,U)
                   WRITE "   "_$PIECE(ERROR,U,LINE),!
 +5        WRITE "   Please contact your help desk for assistance.",!!
 +6        HANG 5
 +7        QUIT -1
EXIT      ;EP
 +1        WRITE @IOF
 +2        DO KILLALL^WVUTL8
 +3        QUIT 
 +4       ;
PRINTX    ;EP
 +1       ;---> PRINTS TEXT.
 +2        NEW I,T,X
           SET T=$$REPEAT^XLFSTR(" ",WVTAB)
 +3        FOR I=1:1
               SET X=$TEXT(@WVLINL+I)
               if X'[";;"
                   QUIT 
               WRITE !,T,$PIECE(X,";;",2)
 +4        QUIT 
 +5       ;
NAME(DIC,Y) ;EP
 +1        NEW WVDFN
 +2        IF DIC="^WV(790,"
               SET WVDFN=Y
 +3       IF '$TEST
               SET WVDFN=$PIECE(@(DIC_Y_",0)"),U,2)
 +4        WRITE !!?3,$$NAME^WVUTL1(WVDFN),"   ",$$SSN^WVUTL1(WVDFN),!
 +5        QUIT 
 +6       ;
 +7       ;
NONE      ;EP
 +1        SET WVTITLE="* There are no PAP Regimen Log entries for this patient. *"
 +2        DO CENTERT^WVUTL5(.WVTITLE)
 +3        WRITE !!!!,WVTITLE,!!
 +4        DO DIRZ^WVUTL3
 +5        QUIT 
NUMRECS(DFN) ;RETURN THE NUMBER OF PREGNANCY AND LACTATION RECORDS
 +1        NEW COUNT,NODE,IEN
 +2        SET COUNT=0
 +3        FOR NODE=4,5
               SET IEN=0
               FOR 
                   SET IEN=$ORDER(^WV(790,DFN,NODE,IEN))
                   if '+IEN
                       QUIT 
                   Begin DoDot:1
 +4                    IF $PIECE($GET(^WV(790,DFN,NODE,IEN,0)),U,6)'=1
                           SET COUNT=COUNT+1
                   End DoDot:1
 +5        QUIT COUNT