source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVNOTIF.m@ 1458

WVNOTIF ;HCIOFO/FT,JR-WV ADD/EDIT WV NOTIFICATIONS; ;6/10/99  17:14
 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
 ;;  Original routine created by IHS/ANMC/MWR
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  CALLED BY DIFFERENT OPTIONS TO ADD/EDIT NOTIFICATIONS.
 ;
ADD ;EP
 ;---> CALLED BY OPTION: "WV ADD A NEW NOTIFICATION".
 D SETVARS^WVUTL5
 D TITLE^WVUTL5("ADD NEW NOTIFICATION")
 D PATLKUP^WVUTL8(.Y)
 D:Y>0 NEW(+Y)
 D EXIT
 Q
 ;
 ;
EDIT ;EP
 ;---> CALLED BY OPTION: "WV EDIT NOTIFICATION".
 ;---> EDIT AN EXISTING NOTIFICATION.
 N WVENFLAG S WVENFLAG=0
 F  Q:WVENFLAG<0  D EDIT1
 Q
EDIT1 ;
 D SETVARS^WVUTL5
 N WVDICB,Y
 D TITLE^WVUTL5("EDIT A NOTIFICATION")
 S WVDICB=+$G(^DISV(DUZ,"^WV(790.4,"))
 S WVDICB=$S(WVDICB>0:$$GET1^DIQ(2,+$P($G(^WV(790.4,WVDICB,0)),U),.01,"E"),1:"")
 I WVDICB="" D DIC^WVFMAN(790.4,"QEMA",.Y,"   Select PATIENT: ")
 I WVDICB]"" D DIC^WVFMAN(790.4,"QEMA",.Y,"   Select PATIENT: ",WVDICB)
 I Y<0 D EXIT S WVENFLAG=-1 Q
 D EDIT2(+Y),EXIT
 Q
 ;
EXIT ;EP
 D KILLALL^WVUTL8
 Q
 ;
 ;
NEW(WVDFN,WVACCN) ;EP
 ;---> STUFF NEW ENTRY IN WV NOTIFICATION FILE, .01=DFN.
 ;---> REQUIRED VARIABLE: WVDFN=IEN OF WV PATIENT, FILE 790.
 ;---> OPTIONAL VARIABLE: WVACCN=ACCESSION# FOR PROCEDURE.
 I $$DECEASED^WVUTL1(WVDFN) D  Q
 .W !!?5,"This patient is registered as deceased." D DIRZ^WVUTL3
 N DA,DIC,X
 S X=WVDFN K DD,DO
 S DIC="^WV(790.4,",DIC(0)="ML",DLAYGO=790
 S DIC("DR")=".02///T;.06///"_$S($D(WVACCN):$P(WVACCN,","),1:"")
 S DIC("DR")=DIC("DR")_";.07////"_$G(DUZ(2))
 D FILE^DICN K DD,DO,DIC
 ;---> IF Y<0, CHECK PERMISSIONS.
 I Y<0 D ERROR1 Q
 D EDIT2(+Y)
 Q
 ;
 ;
EDIT2(DA) ;EP - FROM WVBRNOT2
 ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.4,.
 N WVDA D SETVARS^WVUTL5
 S WVDFN=$P(^WV(790.4,DA,0),U)
 D SCREEN(DA,WVDFN,.WVPOP)
 Q:WVPOP
 I $G(DA) S WVDA=DA D PRINTNOW
 ;---> OPPORTUNITY TO EDIT PATIENT'S CASE DATA.
 ;---> IF $D(WVLOOP), NEW (ABOVE) WAS CALLED FROM CASEDATA^WVPATE,
 ;---> SO DON'T LOOP THROUGH AGAIN.
 D:'$D(WVLOOP) CASEDATA^WVPATE(WVDFN)
 Q
 ;
 ;
SCREEN(DA,WVDFN,WVPOP) ;EP
 ;---> EDIT WITH SCREENMAN.
 ;---> NEEDS WVDFN FOR SCREEN ON ACCESSION# FIELD LOOKUP.
 S DDSFILE=790.4,DR="[WV NOTIF-FORM-1]",WVPOP=0
 ;---> IF THIS NOTIFICATION HAS ALREADY BEEN PRINTED, THEN DISALLOW
 ;---> THE USER TO EDIT MOST FIELDS BY USING FORM-2 BELOW.
 S:$P(^WV(790.4,DA,0),U,10) DR="[WV NOTIF-FORM-2]"
 D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
 Q
 ;
 ;
PRINTNOW ;EP
 ;---> PRINT OR VIEW NOTIFICATION NOW, IF IT'S A LETTER.
 ;---> REQUIRED VARIABLE: WVDA=IEN IN ^WV(790.4,
 Q:'$D(WVDA)
 ;---> QUIT IF THIS NOTIFICATION DOES NOT HAVE A "TYPE OF NOTIFICATION".
 Q:'$P(^WV(790.4,WVDA,0),U,3)
 ;---> QUIT IF TYPE OF NOTIFICATION IS NOT PRINTABLE.
 Q:'$P(^WV(790.403,$P(^WV(790.4,WVDA,0),U,3),0),U,2)
 ;---> QUIT IF THIS NOTIFICATION HAS ALREADY BEEN PRINTED.
 ;Q:$P(^WV(790.4,WVDA,0),U,10) ;DISABLED FOR NOW, ALLOW VIEW OR REPRINT.
 F  D  Q:WVPOP  Q:$P(^WV(790.4,WVDA,0),U,10)
 .N WVCRT,DA,DIR
 .N WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ
 .W !!,"Do you wish to PREVIEW or PRINT this letter now?"
 .S DIR(0)="Y",DIR("B")="NO" D HELP2
 .D ^DIR K DIR W !
 .I $D(DIRUT)!(Y<1) S WVPOP=1 Q
 .;---> QUIT IF NOT ASSOCIATED WITH THE USER'S CURRENT FACILITY.
 .N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
 .I ((WVFACIL'=DUZ(2))&(WVFACIL)) D  S WVPOP=1 Q
 ..D TEXT1^WVLETPR,DIRZ^WVUTL3
 .I Y D DEVICE^WVLETPR Q:WVPOP  D PRINT^WVLETPR
 Q
 ;
ERROR1 ;EP
 W !!?10,*7,"NEW NOTIFICATION ENTRY FOR THIS PATIENT FAILED."
 D DIRZ^WVUTL3
 Q
 ;
ADDNOTIF ;EP
 ;---> ADD NEW NOTIFICATION.
 ;---> AT PRESENT THIS EP IS NOT CALLED BY ANTHING.
 W !,"Do you wish to add a NEW Notification for this patient?"
 S DIR(0)="Y",DIR("B")="NO" D HELP1
 D ^DIR K DIR W !
 I Y D
 .N WVLOOP,DIC,DIE,Y
 .S Y=WVDFN,WVLOOP=1 D NEW(WVDFN)
 Q
 ;
HELP1 ;EP
 ;;Enter YES to add a NEW Notification for this patient.  If the
 ;;notification is a letter, the letter may be queued to print shortly
 ;;before the patient's next appointment by selecting an appropriate
 ;;"Print Date".
 S WVTAB=5,WVLINL="HELP1" D HELPTX
 Q
 ;
HELP2 ;EP
 ;;"Preview" allows you to look at the letter that has just been queued.
 ;;To preview this letter, select HOME at the "DEVICE: " prompt.
 ;;
 ;;"Print" will print the letter now (regardless of its "Print Date")
 ;;and remove it from the queue of letters waiting to print.
 ;;To print this letter now, select a printer at the "DEVICE: " prompt.
 S WVTAB=5,WVLINL="HELP2" D HELPTX
 Q
 ;
HELPTX ;EP
 ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: WVTAB,WVLINL.
 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  S DIR("?",I)=T_$P(X,";;",2)
 S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
 Q