| 1 | WVMGRP ;HCIOFO/FT,JR IHS/ANMC/MWR - MANAGER'S PATIENT EDITS ;7/29/98  16:44
 | 
|---|
| 2 |  ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 | 
|---|
| 3 |  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 | 
|---|
| 4 |  ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG
 | 
|---|
| 5 |  ;;  AND PREGNANCY LOG.
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | PLOG ;EP
 | 
|---|
| 8 |  ;---> CALLED BY OPTION: "WV EDIT PAP REGIMEN LOG".
 | 
|---|
| 9 |  D SETVARS^WVUTL5
 | 
|---|
| 10 |  N A,DR,Y
 | 
|---|
| 11 |  F  D  Q:$G(Y)<0
 | 
|---|
| 12 |  .D TITLE^WVUTL5("EDIT PAP REGIMEN LOG")
 | 
|---|
| 13 |  .D PLOGTX W !
 | 
|---|
| 14 |  .S A="   Select PATIENT (or Enter a new BEGIN DATE): "
 | 
|---|
| 15 |  .D DIC^WVFMAN(790.04,"QEMAL",.Y,A)
 | 
|---|
| 16 |  .Q:Y<0  K WVJR
 | 
|---|
| 17 |  .I $P($G(^WV(790.04,+Y,0)),U,2)="" S WVJR=+Y,DIK="^WV(790.04," D DEL Q
 | 
|---|
| 18 |  .D NAME("^WV(790.04,",+Y)
 | 
|---|
| 19 |  .S DR=".01;.03"
 | 
|---|
| 20 |  .D DIE^WVFMAN(790.04,DR,+Y,.WVPOP)
 | 
|---|
| 21 |  .S:WVPOP Y=-1
 | 
|---|
| 22 |  .Q
 | 
|---|
| 23 |  K WVJR
 | 
|---|
| 24 |  D EXIT
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 | DEL ; Delete File 790.04 or 790.05 entry if no patient
 | 
|---|
| 27 |  S DA=WVJR D ^DIK D
 | 
|---|
| 28 |  .W !!?10,"****  Patient Name Required  ---  Entry Deleted  ****",!!
 | 
|---|
| 29 |  D DIRZ^WVUTL3 Q
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 | PLOGTX ;EP
 | 
|---|
| 32 |  ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN
 | 
|---|
| 33 |  ;;         Log, be SURE that another entry with the same "BEGIN DATE:"
 | 
|---|
| 34 |  ;;         does not already exist for this patient.
 | 
|---|
| 35 |  ;;
 | 
|---|
| 36 |  ;;         (Ordinarily, the program checks this and will not allow
 | 
|---|
| 37 |  ;;         two separate entries for the same patient on the same
 | 
|---|
| 38 |  ;;         "BEGIN DATE:".  But under this option you, as the Manager,
 | 
|---|
| 39 |  ;;         have greater edit capability.)
 | 
|---|
| 40 |  S WVTAB=5,WVLINL="PLOGTX" D PRINTX
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | EDC ;EP
 | 
|---|
| 45 |  ;---> CALLED BY OPTION: "WV EDIT PREGNANCY LOG".
 | 
|---|
| 46 |  D SETVARS^WVUTL5
 | 
|---|
| 47 |  N A,DR,Y
 | 
|---|
| 48 |  F  D  Q:$G(Y)<0
 | 
|---|
| 49 |  .D TITLE^WVUTL5("EDIT PREGNANCY LOG")
 | 
|---|
| 50 |  .S A="   Select PATIENT (or Enter a new DATE): "
 | 
|---|
| 51 |  .D DIC^WVFMAN(790.05,"QEMAL",.Y,A)
 | 
|---|
| 52 |  .Q:Y<0  K WVJR
 | 
|---|
| 53 |  .I $P($G(^WV(790.05,+Y,0)),U,2)="" S WVJR=+Y,DIK="^WV(790.05," D DEL Q
 | 
|---|
| 54 |  .D NAME("^WV(790.05,",+Y)
 | 
|---|
| 55 |  .S DR=".01;.03;.04"
 | 
|---|
| 56 |  .D DIE^WVFMAN(790.05,DR,+Y,.WVPOP)
 | 
|---|
| 57 |  .S:WVPOP Y=-1
 | 
|---|
| 58 |  .Q
 | 
|---|
| 59 |  K WVJR
 | 
|---|
| 60 |  D EXIT
 | 
|---|
| 61 |  Q
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | EXIT ;EP
 | 
|---|
| 64 |  W @IOF
 | 
|---|
| 65 |  D KILLALL^WVUTL8
 | 
|---|
| 66 |  Q
 | 
|---|
| 67 |  ;
 | 
|---|
| 68 | PRINTX ;EP
 | 
|---|
| 69 |  ;---> PRINTS TEXT.
 | 
|---|
| 70 |  N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
 | 
|---|
| 71 |  F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
 | 
|---|
| 72 |  Q
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | NAME(DIC,Y) ;EP
 | 
|---|
| 75 |  N WVDFN
 | 
|---|
| 76 |  S WVDFN=$P(@(DIC_Y_",0)"),U,2)
 | 
|---|
| 77 |  W !!?3,$$NAME^WVUTL1(WVDFN),"   ",$$SSN^WVUTL1(WVDFN),!
 | 
|---|
| 78 |  Q
 | 
|---|
| 79 |  ;
 | 
|---|
| 80 |  ;
 | 
|---|
| 81 | NONE ;EP
 | 
|---|
| 82 |  S WVTITLE="* There are no PAP Regimen Log entries for this patient. *"
 | 
|---|
| 83 |  D CENTERT^WVUTL5(.WVTITLE)
 | 
|---|
| 84 |  W !!!!,WVTITLE,!!
 | 
|---|
| 85 |  D DIRZ^WVUTL3
 | 
|---|
| 86 |  Q
 | 
|---|