- 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 Feb 19, 2025@00:13:42 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