Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVMGRP

WVMGRP.m

Go to the documentation of this file. 
  1. 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
  1.  ;;IHS/ANMC/MWR * MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG
  1.  ;;  AND PREGNANCY/LACTATION STATUS DATA.
  1.  ;
  1. PLOG ;EP
  1.  ;---> CALLED BY OPTION: "WV EDIT PAP REGIMEN LOG".
  1.  D SETVARS^WVUTL5
  1.  N A,DR,Y
  1.  F  D  Q:$G(Y)<0
  1.  .D TITLE^WVUTL5("EDIT PAP REGIMEN LOG")
  1.  .D PLOGTX W !
  1.  .S A="   Select PATIENT (or Enter a new BEGIN DATE): "
  1.  .D DIC^WVFMAN(790.04,"QEMAL",.Y,A)
  1.  .Q:Y<0  K WVJR
  1.  .I $P($G(^WV(790.04,+Y,0)),U,2)="" N DIK S WVJR=+Y,DIK="^WV(790.04," D DEL Q
  1.  .D NAME("^WV(790.04,",+Y)
  1.  .S DR=".01;.03"
  1.  .D DIE^WVFMAN(790.04,DR,+Y,.WVPOP)
  1.  .S:WVPOP Y=-1
  1.  .Q
  1.  K WVJR
  1.  D EXIT
  1.  Q
  1. DEL ; Delete File 790.04 entry if no patient
  1.  S DA=WVJR D ^DIK
  1.  W !!?10,"****  Patient Name Required  ---  Entry Deleted  ****",!!
  1.  D DIRZ^WVUTL3 Q
  1.  ;
  1. PLOGTX ;EP
  1.  ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN
  1.  ;;         Log, be SURE that another entry with the same "BEGIN DATE:"
  1.  ;;         does not already exist for this patient.
  1.  ;;
  1.  ;;         (Ordinarily, the program checks this and will not allow
  1.  ;;         two separate entries for the same patient on the same
  1.  ;;         "BEGIN DATE:".  But under this option you, as the Manager,
  1.  ;;         have greater edit capability.)
  1.  S WVTAB=5,WVLINL="PLOGTX" D PRINTX
  1.  Q
  1.  ;
  1.  ;
  1. PLSDATA ;EDIT PREGNANCY/LACTATION STATUS DATA
  1.  ;---> CALLED BY OPTION: "WV EDIT PREG/LAC STATUS DATA".
  1.  D SETVARS^WVUTL5
  1.  N A,Y,DIK,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT,WVPAT
  1.  F  D  Q:$G(Y)=-1!($D(XQAID))
  1.  .D TITLE^WVUTL5("EDIT PREGNANCY/LACTATION STATUS DATA")
  1.  .I '$D(XQAID) D
  1.  ..S A="   Select PATIENT: "
  1.  ..D DIC^WVFMAN(790,"QEMA",.Y,A,,"I $O(^WV(790.8,""B"",Y,0))'=""""!($$NUMRECS^WVMGRP(Y)>0)")
  1.  ..I +$G(Y)<1 S Y=-1,WVPAT=0 Q
  1.  ..K WVJR,DA
  1.  ..S WVPAT=+Y
  1.  ..W !
  1.  .I $D(XQAID) S WVPAT=+$P(XQAID,",",2)
  1.  .Q:'WVPAT
  1.  .S WVPAT("NAME")=$$EXTERNAL^DILFD(790,.01,"",WVPAT)
  1.  .I $O(^WV(790.8,"B",WVPAT,0))'="" D  Q
  1.  ..D DOCACT^WVMGRP1
  1.  ..I $O(^WV(790.8,"B",WVPAT,0))="" D
  1.  ...N XQAID,XQAKILL
  1.  ...S XQAID="WV,"_WVPAT_",1"
  1.  ...D DELETEA^XQALERT
  1.  .I $D(XQAID),$O(^WV(790.8,"B",WVPAT,0))="" W "There are no status review records for "_WVPAT("NAME")_".",! H 5 Q
  1.  .I $O(^WV(790,WVPAT,4,"B",0))'=""!($O(^WV(790,WVPAT,5,"B",0))'="") D MANAGE Q
  1.  .W "There are no status records for "_WVPAT("NAME")_".",! H 5 Q
  1.  I $D(XQAID) D
  1.  .I $O(^WV(790.8,"B",WVPAT,0))'="" K XQAKILL
  1.  .E  S XQAKILL=0
  1.  D EXIT
  1.  Q
  1. MANAGE ;MANAGE STATUS DATA INDIVIDUALLY
  1.  N WVDIRP2,WVNODE,WVGOTIT,WVDATE,WVIEN,WVENTS,WVEXIT,WVPROMPT,WVRETURN
  1.  S WVNODE(4)="Pregnancy"_U_790.05,WVNODE(5)="Lactation"_U_790.16
  1.  S WVNODE=0 F  S WVNODE=$O(WVNODE(WVNODE)) Q:'+WVNODE  D
  1.  .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
  1.  ..Q:$P($G(^WV(790,WVPAT,WVNODE,WVIEN,0)),U,6)
  1.  ..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)
  1.  ..S WVDIRP2(1)=$E(WVNODE(WVNODE),1)_":"_$P(WVNODE(WVNODE),U)
  1.  .I $G(WVDIRP2(1))'="" S WVDIRP2=$S($G(WVDIRP2)'="":WVDIRP2_";",1:"")_WVDIRP2(1)
  1.  .I '$D(WVDIRP2(1)) K WVNODE(WVNODE)
  1.  .K WVDIRP2(1)
  1.  I $D(WVNODE)<10 S Y=-2 Q
  1.  I $L(WVDIRP2,";")>1 D  Q:$G(Y)=-1
  1.  .S DIR(0)="S"_U_WVDIRP2,DIR("A")="   Select DATA TYPE"
  1.  .S DIR("?")="Enter the letter to the left of the type of status data you want to work with."
  1.  .D ^DIR
  1.  .I $D(DIRUT)!($D(DIROUT)) S Y=-1 Q
  1.  .W !
  1.  .S WVNODE=0 F  S WVNODE=$O(WVNODE(WVNODE)) Q:'+WVNODE!($G(WVGOTIT))  I $E(WVNODE(WVNODE),1)=Y S WVGOTIT=WVNODE
  1.  .S WVNODE=$G(WVGOTIT)
  1.  I $L(WVDIRP2,";")=1 S WVNODE=$O(WVENTS(0))
  1.  F  Q:$G(WVEXIT)'=""  D
  1.  .I WVENTS(WVNODE)>1 D  Q:$G(WVEXIT)'=""
  1.  ..N WVLINE,END,X
  1.  ..S WVLINE=1
  1.  ..W !,"   The following "_$$LOW^XLFSTR($P(WVNODE(WVNODE),U))_" status data is on file:",!!
  1.  ..S WVENTS=0 F  S WVENTS=$O(WVENTS(WVNODE,WVENTS)) Q:'+WVENTS!($G(END))  D
  1.  ...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
  1.  ...W ?5,$$RJ^XLFSTR(WVENTS," ",3),?11,$P(WVENTS(WVNODE,WVENTS),U,2),!
  1.  ...S WVLINE=WVLINE+1
  1.  ..S DIR(0)="NO"_U_U_"K:'$D(WVENTS(WVNODE,X)) X",DIR("A")="Select the data you want to work with"
  1.  ..S DIR("?")="Enter the number to the left of the status data you want to work with."
  1.  ..D ^DIR
  1.  ..I $D(DTOUT)!($D(DUOUT)) S WVEXIT=-1 Q
  1.  ..W !
  1.  ..I Y="" S WVEXIT=-2 Q
  1.  ..K DIR
  1.  ..S WVENTS("Y")=Y
  1.  .I WVENTS(WVNODE)=1 S WVENTS("Y")=$O(WVENTS(WVNODE,0))
  1.  .I WVENTS(WVNODE)=0 S WVEXIT=-2 Q
  1.  .S WVRETURN=$$SHODATA^WVMGRP1
  1.  .I WVRETURN=-1 S WVEXIT=WVRETURN Q
  1.  .S DIR(0)="Y"_U,DIR("A")="Do you want to mark this status data as entered in error"
  1.  .S DIR("?",1)="If the status displayed is valid as of the date and time it was entered, enter"
  1.  .S DIR("?",2)="'N' for no (you do not want to mark the status as entered in error). If the"
  1.  .S DIR("?",3)="status was never valid, enter 'Y' for yes (you do want to mark the status as"
  1.  .S DIR("?")="entered in error)."
  1.  .D ^DIR
  1.  .I $D(DIRUT)!($D(DIROUT)) S WVEXIT=-1 Q
  1.  .K DIR
  1.  .I Y D  Q
  1.  ..S WVPROMPT=+WVENTS(WVNODE,WVENTS("Y"))_","_WVPAT_",",WVEXIT=$$PACT^WVMGRP2(WVNODE,2) Q:WVEXIT=-1
  1.  ..S WVENTS(WVNODE)=WVENTS(WVNODE)-1
  1.  ..K WVENTS(WVNODE,WVENTS("Y"))
  1.  ..K WVEXIT
  1.  .I 'Y S WVEXIT=1
  1.  I $G(WVEXIT)'="" S Y=WVEXIT
  1.  Q
  1.  ;
  1. ERROR(ACTION,FMERROR,ERROR) ;DISPLAY ERROR MESSAGE
  1.  N LINE
  1.  W !,"   Error while "_$G(ACTION)_":",!
  1.  I $D(FMERROR)>9 W "   "_$$FMERROR^WVUTL11(.FMERROR),!
  1.  I $D(ERROR)=1 F LINE=1:1:$L(ERROR,U) W "   "_$P(ERROR,U,LINE),!
  1.  W "   Please contact your help desk for assistance.",!!
  1.  H 5
  1.  Q -1
  1. EXIT ;EP
  1.  W @IOF
  1.  D KILLALL^WVUTL8
  1.  Q
  1.  ;
  1. PRINTX ;EP
  1.  ;---> PRINTS TEXT.
  1.  N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
  1.  F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q
  1.  ;
  1. NAME(DIC,Y) ;EP
  1.  N WVDFN
  1.  I DIC="^WV(790," S WVDFN=Y
  1.  E  S WVDFN=$P(@(DIC_Y_",0)"),U,2)
  1.  W !!?3,$$NAME^WVUTL1(WVDFN),"   ",$$SSN^WVUTL1(WVDFN),!
  1.  Q
  1.  ;
  1.  ;
  1. NONE ;EP
  1.  S WVTITLE="* There are no PAP Regimen Log entries for this patient. *"
  1.  D CENTERT^WVUTL5(.WVTITLE)
  1.  W !!!!,WVTITLE,!!
  1.  D DIRZ^WVUTL3
  1.  Q
  1. NUMRECS(DFN) ;RETURN THE NUMBER OF PREGNANCY AND LACTATION RECORDS
  1.  N COUNT,NODE,IEN
  1.  S COUNT=0
  1.  F NODE=4,5  S IEN=0 F  S IEN=$O(^WV(790,DFN,NODE,IEN)) Q:'+IEN  D
  1.  .I $P($G(^WV(790,DFN,NODE,IEN,0)),U,6)'=1 S COUNT=COUNT+1
  1.  Q COUNT