source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVUTL4.m@ 1397

WVUTL4 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES; ;7/16/98  09:44
 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
 ;;  STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
 ;
 ;
NDELQ() ;EP
 ;---> FOR NOTIFICATIONS:
 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
 ;---> NOTIFICATION BECOMES DELINQUENT.  CALLED BY WV NOTIF-EDITBLK-1.
 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
 ;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
 ;--->                         2: DATE NOTIFICATION OPENED, OR
 ;--->                         3: TODAY'S DATE
 ;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
 ;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
 N X
 Q:'$D(DA) ""
 Q:'DA ""
 Q:'$D(^WV(790.4,DA,0)) ""
 S X=$P(^WV(790.4,DA,0),U,11)
 S:'X X=$P(^WV(790.4,DA,0),U,2)
 S:'X X=DT
 Q $$NDELQ1
 ;
NDELQ1() ;EP
 ;---> FOR NOTIFICATIONS:
 ;---> COMPUTE "COMPLETE BY (DATE)".  CALLED BY UPDATE/EDIT OF
 ;---> "PRINT DATE:" IN WV NOTIF-EDITBLK-1.
 ;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
 ;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
 ;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
 N %H,X1,X2
 Q:'$D(X) ""
 Q:'X ""
 S X1=X,X2=30
 D C^%DTC
 Q X
 ;
PDELQ(DA,DUZ2) ;EP
 ;---> FOR PROCEDURES:
 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
 ;---> PROCEDURE BECOMES DELINQUENT.  CALLED BY WV PROC-EDITBLK-1.
 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
 ;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
 ;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
 ;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
 Q:'$G(DA)!('$G(DUZ2)) ""
 Q:'$D(^WV(790.1,DA,0)) ""
 Q:'$P(^WV(790.1,DA,0),U,12) ""
 Q $$PDELQ1(DA,$P(^WV(790.1,DA,0),U,12),DUZ2)
 ;
PDELQ1(WVDA,WVDT,WVDUZ2) ;EP
 ;---> FOR PROCEDURES:
 ;---> COMPUTE "COMPLETE BY (WVDT)".  CALLED BY UPWVDT/EDIT OF
 ;---> "WVDT OF PROCEDURE" IN WV PROC-EDITBLK-1.
 ;---> X1=WVDT OF PROCEDURE, X2=DEFAULT NUMBER OF WVDAYS THE
 ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
 ;---> REQUIRED VARIABLE: WVDA=IEN OF PROCEDURE, WVDT=DATE OF PROCEDURE,
 ;--->                    WVDUZ2=DUZ(2).
 N %H,X,X1,X2
 Q:'$G(WVDA)!('$G(WVDT)) ""
 Q:'$D(^WV(790.1,WVDA,0)) ""
 S X2=$P(^WV(790.1,WVDA,0),U,4),X1=WVDT
 Q:'X2 ""
 Q:'$D(^WV(790.02,WVDUZ2,X2)) ""
 S X2=$P(^WV(790.02,WVDUZ2,X2),U,3)
 D C^%DTC
 Q X
 ;
STATUS() ;EP
 ;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
 ;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
 ;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
 Q:'$D(Y) "UNKNOWN"
 Q:$P(Y,U,14)="c" "CLOSED"
 Q:$P(Y,U,13)]""&($P(Y,U,13)<DT) "DELINQ"
 Q "OPEN"
 ;
DIAG(IEN) ;EP
 ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE 790.31.
 Q:'$G(IEN) "NOT ENTERED"
 Q:'$D(^WV(790.31,IEN,0)) "UNKNOWN POINTER"
 Q $P(^WV(790.31,IEN,0),U)
 ;
PRIOR() ;EP
 ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
 Q:'$D(X)!(X']"") 10
 Q:'$D(^WV(790.31,X,0)) 10
 Q:'$P(^WV(790.31,X,0),U,2) 10
 Q $P(^WV(790.31,X,0),U,2)
 ;
NORMAL(X) ;EP
 ;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
 ;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
 ;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
 ;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
 Q:'$D(X)!(X']"") 2
 Q:'$D(^WV(790.31,X,0)) 2
 Q:$P(^WV(790.31,X,0),U,21)="" 2
 Q $P(^WV(790.31,X,0),U,21)
 ;
COLP(DA) ;EP
 ;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
 ;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
 ;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
 ;---> DA=IEN OF PROCEDURE IN PROC FILE #790.1.
 N Y
 Q:'$G(DA) 0
 Q:'$D(^WV(790.1,DA,0)) 0
 S Y=$P(^WV(790.1,DA,0),U,4)
 Q:'Y 0
 Q:'$D(^WV(790.2,Y,0)) 0
 Q:$P(^WV(790.2,Y,0),U,3)<1 0
 Q 1
 ;
COLPA(DA) ;EP
 ;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
 N X,Y
 Q:'$G(DA) ""
 S Y=$$COLP0(DA)
 Q:Y="" "None"
 S X=$P(Y,U)_" on "_$$SLDT2^WVUTL5($P(Y,U,12))
 I $P(Y,U,5) Q X_"^"_$P(^WV(790.31,$P(Y,U,5),0),U)
 Q X_"^"_"Not entered"
 ;
COLP0(DA) ;EP
 ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
 N Y
 Q:'$G(DA) ""
 Q:'$D(^WV(790.1,DA,0)) ""
 Q:'$D(^WV(790.1,"ACOLP",DA)) ""
 S Y=$O(^WV(790.1,"ACOLP",DA,0)),Y=$O(^WV(790.1,"ACOLP",DA,Y,0))
 Q:'$D(^WV(790.1,Y,0)) ""
 Q ^WV(790.1,Y,0)
 ;
MARGIN(DA) ;EP
 ;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
 ;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
 N Y
 Q:'$G(DA) 0
 Q:'$D(^WV(790.1,DA,0)) 0
 S Y=$P(^WV(790.1,DA,0),U,4)
 Q:'Y 0
 Q:'$D(^WV(790.2,Y,0)) 0
 Q:$P(^WV(790.2,Y,0),U,11)<1 0
 Q 1
 ;
STAGE(STAGE) ;EP
 ;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
 Q:'$G(STAGE) ""
 Q:'$D(^DD(790.1,.31,0)) "^DD MISSING"
 Q $P($P(^DD(790.1,.31,0),STAGE_":",2),";")