- WVPATE ;HCIOFO/FT,JR-PATIENT CASE DATA EDIT; ;4/3/01 13:13
- ;;1.0;WOMEN'S HEALTH;**3,13,14**;Sep 30, 1998
- ;; Original routine created by IHS/ANMC/MWR
- ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
- ;; CALLED BY OPTION: "WV EDIT PATIENT CASE DATA".
- ;
- ; This routine uses the following IAs:
- ; #1625 - $$GET^XUA4A72 (supported)
- ;
- D SETVARS^WVUTL5
- F D PATIENT Q:WVPOP
- ;
- EXIT ;EP
- D KILLALL^WVUTL8
- Q
- ;
- ;
- PATIENT ;EP
- D TITLE^WVUTL5("EDIT PATIENT CASE DATA")
- PATIENT1 ;EP
- ;---> TO AVOID @IOF AND TITLE.
- ;---> SELECT PATIENT.
- ; Quit if no default case manager
- I '$$DCM^WVUTL9(DUZ(2)) D NODCM^WVUTL9 S WVPOP=1 Q
- N Y
- W !!," Select the patient you wish to add or edit."
- D PATLKUP^WVUTL8(.Y,"ADD")
- I Y<0 S WVPOP=1 Q
- S WVDFN=+Y
- D SCREEN(WVDFN) S WVPOP=0
- Q
- ;
- ;
- SCREEN(WVDFN) ;EP
- ;---> EDIT PATIENT CASE DATA WITH SCREENMAN.
- ;---> REQUIRED VARIABLES: WVDFN=DFN OF PATIENT.
- I '$P($G(^WV(790,WVDFN,0)),U,10) D STUFF
- N DR
- S DR="[WV PATIENT-FORM-1]"
- D DDS^WVFMAN(790,DR,WVDFN,"","",.WVPOP)
- N DIR W !,"Do you wish to PRINT this patient's Case Data?"
- S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
- D:Y PRTCASE^WVPATP(WVDFN)
- Q
- ;
- CASEDATA(WVDFN) ;EP
- ;---> CALLED AFTER ADD/EDIT OF NOTIFICATIONS.
- N DIR W !,"Do you wish to EDIT this patient's Case Data?"
- S DIR("?",1)=" Enter YES to edit this patient's Case Manager, "
- S DIR("?")=" PAP Regimen, Current Need, etc."
- S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
- D:Y SCREEN(WVDFN)
- Q
- ;
- AUTOADD(DFN,SITE,Y,WVPRMT) ;EP
- ;---> AUTOMATIC ADD OF A NEW PATIENT TO "WV PATIENT FILE".
- ;---> SET CASEMANAGER TO SITE PARAMETER DEFAULT.
- ;---> SET PAP TX NEED (#.11), PAP REGIMEN (#.16)="Undetermined",
- ;---> MAM TX NEED (#.18)="Undetermined".
- ;---> PARAMETERS:
- ; 1 - DFN (REQUIRED) IEN OF PATIENT IN ^DPT(
- ; 2 - SITE (REQUIRED) DUZ(2) FOR DEFAULT CASE MANAGER
- ; 3 - Y (RETURNED) FROM ^DICN: IEN OR -1 FAILURE TO ADD PT
- ; 4 - WVPRMT (OPTIONAL) EQUALS 1 IF PROMPT WHEN FAILURE
- ;
- ;---> SET CASE MANAGER DEFAULT.
- N WVCMGR,DIC S WVCMGR=$S($D(SITE):$P(^WV(790.02,SITE,0),U,2),1:"")
- S:'$G(WVPRMT) WVPRMT=0
- S DIC("DR")=".1////"_WVCMGR_";.11///Undetermined;.16///Undetermined"
- S DIC("DR")=DIC("DR")_";.18///Undetermined"
- S DIC("DR")=DIC("DR")_";.21////"_DT
- S (DINUM,X)=DFN
- K DD,DO S DIC="^WV(790,",DIC(0)="ML",DLAYGO=790
- D FILE^DICN K DIC
- ;---> IF Y<0, CHECK PERMISSIONS.
- I Y<0,WVPRMT D Q
- .W !!?5,"* UNABLE to add this patient to the Women's Health database."
- .W !?5," Please contact your site manager to check permissions."
- .D DIRZ^WVUTL3
- S Y=+Y
- Q
- ;
- STUFF ; Stuff case manager if none
- Q:'+$G(WVDFN)
- Q:'+$G(DUZ(2))
- S $P(^WV(790,WVDFN,0),U,10)=$P($G(^WV(790.02,DUZ(2),0)),U,2)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVPATE 2798 printed Feb 19, 2025@00:13:48 Page 2
- WVPATE ;HCIOFO/FT,JR-PATIENT CASE DATA EDIT; ;4/3/01 13:13
- +1 ;;1.0;WOMEN'S HEALTH;**3,13,14**;Sep 30, 1998
- +2 ;; Original routine created by IHS/ANMC/MWR
- +3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
- +4 ;; CALLED BY OPTION: "WV EDIT PATIENT CASE DATA".
- +5 ;
- +6 ; This routine uses the following IAs:
- +7 ; #1625 - $$GET^XUA4A72 (supported)
- +8 ;
- +9 DO SETVARS^WVUTL5
- +10 FOR
- DO PATIENT
- if WVPOP
- QUIT
- +11 ;
- EXIT ;EP
- +1 DO KILLALL^WVUTL8
- +2 QUIT
- +3 ;
- +4 ;
- PATIENT ;EP
- +1 DO TITLE^WVUTL5("EDIT PATIENT CASE DATA")
- PATIENT1 ;EP
- +1 ;---> TO AVOID @IOF AND TITLE.
- +2 ;---> SELECT PATIENT.
- +3 ; Quit if no default case manager
- +4 IF '$$DCM^WVUTL9(DUZ(2))
- DO NODCM^WVUTL9
- SET WVPOP=1
- QUIT
- +5 NEW Y
- +6 WRITE !!," Select the patient you wish to add or edit."
- +7 DO PATLKUP^WVUTL8(.Y,"ADD")
- +8 IF Y<0
- SET WVPOP=1
- QUIT
- +9 SET WVDFN=+Y
- +10 DO SCREEN(WVDFN)
- SET WVPOP=0
- +11 QUIT
- +12 ;
- +13 ;
- SCREEN(WVDFN) ;EP
- +1 ;---> EDIT PATIENT CASE DATA WITH SCREENMAN.
- +2 ;---> REQUIRED VARIABLES: WVDFN=DFN OF PATIENT.
- +3 IF '$PIECE($GET(^WV(790,WVDFN,0)),U,10)
- DO STUFF
- +4 NEW DR
- +5 SET DR="[WV PATIENT-FORM-1]"
- +6 DO DDS^WVFMAN(790,DR,WVDFN,"","",.WVPOP)
- +7 NEW DIR
- WRITE !,"Do you wish to PRINT this patient's Case Data?"
- +8 SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- WRITE !
- +9 if Y
- DO PRTCASE^WVPATP(WVDFN)
- +10 QUIT
- +11 ;
- CASEDATA(WVDFN) ;EP
- +1 ;---> CALLED AFTER ADD/EDIT OF NOTIFICATIONS.
- +2 NEW DIR
- WRITE !,"Do you wish to EDIT this patient's Case Data?"
- +3 SET DIR("?",1)=" Enter YES to edit this patient's Case Manager, "
- +4 SET DIR("?")=" PAP Regimen, Current Need, etc."
- +5 SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- WRITE !
- +6 if Y
- DO SCREEN(WVDFN)
- +7 QUIT
- +8 ;
- AUTOADD(DFN,SITE,Y,WVPRMT) ;EP
- +1 ;---> AUTOMATIC ADD OF A NEW PATIENT TO "WV PATIENT FILE".
- +2 ;---> SET CASEMANAGER TO SITE PARAMETER DEFAULT.
- +3 ;---> SET PAP TX NEED (#.11), PAP REGIMEN (#.16)="Undetermined",
- +4 ;---> MAM TX NEED (#.18)="Undetermined".
- +5 ;---> PARAMETERS:
- +6 ; 1 - DFN (REQUIRED) IEN OF PATIENT IN ^DPT(
- +7 ; 2 - SITE (REQUIRED) DUZ(2) FOR DEFAULT CASE MANAGER
- +8 ; 3 - Y (RETURNED) FROM ^DICN: IEN OR -1 FAILURE TO ADD PT
- +9 ; 4 - WVPRMT (OPTIONAL) EQUALS 1 IF PROMPT WHEN FAILURE
- +10 ;
- +11 ;---> SET CASE MANAGER DEFAULT.
- +12 NEW WVCMGR,DIC
- SET WVCMGR=$SELECT($DATA(SITE):$PIECE(^WV(790.02,SITE,0),U,2),1:"")
- +13 if '$GET(WVPRMT)
- SET WVPRMT=0
- +14 SET DIC("DR")=".1////"_WVCMGR_";.11///Undetermined;.16///Undetermined"
- +15 SET DIC("DR")=DIC("DR")_";.18///Undetermined"
- +16 SET DIC("DR")=DIC("DR")_";.21////"_DT
- +17 SET (DINUM,X)=DFN
- +18 KILL DD,DO
- SET DIC="^WV(790,"
- SET DIC(0)="ML"
- SET DLAYGO=790
- +19 DO FILE^DICN
- KILL DIC
- +20 ;---> IF Y<0, CHECK PERMISSIONS.
- +21 IF Y<0
- IF WVPRMT
- Begin DoDot:1
- +22 WRITE !!?5,"* UNABLE to add this patient to the Women's Health database."
- +23 WRITE !?5," Please contact your site manager to check permissions."
- +24 DO DIRZ^WVUTL3
- End DoDot:1
- QUIT
- +25 SET Y=+Y
- +26 QUIT
- +27 ;
- STUFF ; Stuff case manager if none
- +1 if '+$GET(WVDFN)
- QUIT
- +2 if '+$GET(DUZ(2))
- QUIT
- +3 SET $PIECE(^WV(790,WVDFN,0),U,10)=$PIECE($GET(^WV(790.02,DUZ(2),0)),U,2)
- +4 QUIT