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