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

WVUTL6.m

Go to the documentation of this file. 
  1. WVUTL6 ;HCIOFO/FT,JR-UTIL: TEXT VALS, DEF PRINT DATE; ;10/11/99  14:03
  1.  ;;1.0;WOMEN'S HEALTH;**3,7**;Sep 30, 1998
  1.  ;;  Original routine created by IHS/ANMC/MWR
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  UTILITY: TEXT FOR PROVIDER, PROCEDURE, HOSP LOC, INSTIT, & ECC.
  1.  ;;  PROC SPECIAL VALUE (PAP, MAM, COLP).  COMPUTE DEFAULT PRINT DATE.
  1.  ;
  1.  ;
  1. PROV() ;EP
  1.  ;---> RETURN TEXT OF PROVIDER'S NAME.
  1.  ;---> REQUIRED VARIABLE: X=IEN IN NEW PERSON FILE #200.
  1.  N WVNAME
  1.  Q:'$D(X) ""
  1.  Q:'X "UNKNOWN"
  1.  S WVNAME=$$GET1^DIQ(200,X,.01,"E")
  1.  Q $S(WVNAME'="":WVNAME,1:"UNKNOWN POINTER")
  1.  ;
  1.  ;
  1. PCDNAM() ;EP
  1.  ;---> RETURN TEXT OF PROCEDURE TYPE.
  1.  ;---> REQUIRED VARIABLE: X=IEN IN WV PROCEDURE TYPE FILE #790.2.
  1.  Q:'$D(X) ""
  1.  Q:'X "UNKNOWN"
  1.  Q:'$D(^WV(790.2,X,0)) "UNKNOWN POINTER"
  1.  Q $P(^WV(790.2,X,0),U)
  1.  ;
  1. HOSPLC() ;EP
  1.  ;---> RETURN TEXT OF HOSPITAL LOCATION NAME.
  1.  ;---> REQUIRED VARIABLE: X=IEN IN HOSPITAL LOCATION FILE #44.
  1.  Q:'$D(X) ""
  1.  Q:'X "UNKNOWN"
  1.  Q:'$D(^SC(X,0)) "UNKNOWN POINTER"
  1.  Q $P(^SC(X,0),U)
  1.  ;
  1. INSTIT() ;EP
  1.  ;---> RETURN IEN OF INSTITUTION (FACILITY) FILE 4, FOR THIS HOSPITAL
  1.  ;---> LOCATION ENTRY IN HOSPITAL LOCATION FILE 44.
  1.  ;---> ALSO CONCATENATE "`" TO THE FRONT OF IEN FOR USE IN DR STRINGS.
  1.  Q:'$D(X) ""
  1.  Q:X="" ""
  1.  Q:'$D(^SC(X,0)) ""
  1.  Q:$P(^SC(X,0),U,4)']"" ""
  1.  Q "`"_$P(^SC(X,0),U,4)
  1.  ;
  1. INSTTX(FACILITY) ;EP
  1.  ;---> RETURN TEXT OF INSTITUTION (FACILITY) NAME.
  1.  ;---> REQUIRED VARIABLE: X=IEN IN INSTITUTION FILE #4.
  1.  Q:'$G(FACILITY) ""
  1.  N WVDIC4
  1.  S WVDIC4=$$GET1^DIQ(4,FACILITY,.01,"E")
  1.  Q $S(WVDIC4]"":WVDIC4,1:"UNKNOWN POINTER")
  1.  ;
  1. ECCDYS() ;EP
  1.  ;---> RETURN TEXT FROM SET OF CODES FOR ECC DYSPLASIA, FIELD .25,
  1.  ;---> OF PROCEDURE FILE 790.1.
  1.  ;---> REQUIRED VARIABLE: X=CODE FOR TEXT OF ECC DYSPLASIA.
  1.  Q:'$D(X) ""
  1.  Q:X="" ""
  1.  I '$$VFIELD^DILFD(790.1,.25) Q "^DD MISSING"
  1.  Q $$EXTERNAL^DILFD(790.1,.25,"",X)
  1.  ;
  1. PNOCX(IEN) ;EP
  1.  ;---> RETURN 1 IF THIS PROCEDURE IS NOT ANY TYPE OF CERVICAL TX.
  1.  Q:'$G(IEN) 1
  1.  Q:'$D(^WV(790.2,IEN,0)) 1
  1.  Q:$$PMAM(IEN) 1
  1.  Q:IEN=27 1  Q:IEN=29 1  Q:IEN=30 1  Q:IEN=31 1  Q:IEN=32 1
  1.  Q:IEN=33 1  Q:IEN=34 1  Q:IEN=35 1
  1.  Q 0
  1.  ;
  1.  ;
  1. PMAM(IEN) ;EP
  1.  ;---> RETURN 1 IF THIS PROCEDURE IS ANY TYPE OF MAMMOGRAM, RETURN 0
  1.  ;---> IF NOT.
  1.  ;---> REQUIRED VARIABLE: IEN=IEN IN PROCEDURE TYPE FILE #790.2.
  1.  ;---> 25, 26, AND 27 ARE IENS OF MAMS IN ^WV(790.2,.
  1.  Q:'$G(IEN) 0
  1.  Q:IEN=25 1  Q:IEN=26 1  Q:IEN=28 1
  1.  Q 0
  1.  ;
  1.  ;
  1. PRTDATE ;EP
  1.  ;---> CALL BY WV NOTIF-EDITBLK-1 TO COMPUTE AND STUFF DATE NOTIFICATION
  1.  ;---> LETTER WILL BE PRINTED, "Print Date" FIELD.  CALLED FROM
  1.  ;---> "TYPE OF NOTIFICATION" FIELD ORDER, "POST ACTION ON CHANGE".
  1.  ;--->
  1.  ;---> IF THE "TYPE OF NOTIFICATION" IS PRINTABLE (LETTER), AS STORED
  1.  ;---> IN #.02 FIELD OF FILE #790.403, THIS COMPUTES PRINT DATE AND
  1.  ;---> STUFFS A DEFAULT "COMPLETE BY DATE" (FIELD #.13) AS WELL.
  1.  ;---> "PRINT DATE" WILL BE CX/BR NEED DUE DATE - SITE PARAMETER, AS
  1.  ;---> STORED IN #.06 FIELD OF FILE #790.02, OR -30 DAYS IF
  1.  ;---> PARAMETER NOT SET.  (SEE PRTDAT^WVUTL2-ABOVE.)
  1.  ;---> "COMPLETE BY DATE" WILL BE "PRINT DATE"+30. SEE NDELQ1^WVUTL4.
  1.  ;--->
  1.  ;---> IF THE "TYPE OF NOTIFICATION" IS NOT PRINTABLE (PHONE), THIS
  1.  ;---> SETS "PRINT DATE"="" AND RECOMPUTES "COMPLETE BY DATE" BASED ON
  1.  ;---> DATE NOTIFICATION WAS OPENED (FIELD #.02) +30 DAYS.
  1.  ;
  1.  ;---> (NOTE: FOR UNIFORMITY, EXECUTABLE DEFAULT FOR "PRINT DATE"
  1.  ;---> CALLS THIS CODE TO SET ITS STORED VALUE, THEN SETS ITS DEFAULT
  1.  ;---> EQUAL TO ITS STORED VALUE.)
  1.  ;--->
  1.  ;---> REQUIRED VARIABLES: WVDFN=IEN OF PATIENT
  1.  ;--->                     DUZ(2)=SITE
  1.  ;--->                     WVTYPE=IEN TYPE OF NOTIFICATION (LETTER, ETC)
  1.  ;--->                     WVPURP=IEN PURPOSE OF NOTIFICATION
  1.  ;
  1.  N WVTYPE,WVPURP,X,Y
  1.  S WVTYPE=$$GET^DDSVAL(DIE,DA,.03)
  1.  I 'WVTYPE D PUT^DDSVAL(DIE,DA,.11,"") Q
  1.  ;---> IF NOT PRINTABLE, SET PRINT DATE="".
  1.  I '$P(^WV(790.403,WVTYPE,0),U,2) D  Q
  1.  .D PUT^DDSVAL(DIE,DA,.11,"")
  1.  .S X=$$NDELQ^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)
  1.  S WVPURP=$$GET^DDSVAL(DIE,DA,.04)
  1.  ;---> COMPUTE AND STUFF PRINT DATE.
  1.  D PRTDAT(WVDFN,DUZ(2),WVTYPE,WVPURP,.X)
  1.  D PUT^DDSVAL(DIE,DA,.11,X)
  1.  ;---> COMPUTE AND STUFF COMPLETE BY DATE.
  1.  S X=$$NDELQ1^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)
  1.  Q
  1.  ;
  1.  ;
  1. PRTDAT(DFN,DUZ2,TYPE,PURP,DATE) ;EP
  1.  ;---> YIELD PATIENT'S LETTER PRINT DATE, BASED ON CX/BR NEED.
  1.  ;---> DUE DATE MINUS SITE PARAMETER (OR 30 DAYS, IF NOT SET).
  1.  ;---> TYPE OF NOTIFICATION MUST BE "PRINTABLE" (#.02 OF #790.403).
  1.  ;---> REQUIRED VARIABLES: DFN=IEN OF PATIENT
  1.  ;--->                     DUZ2=DUZ(2)
  1.  ;--->                     TYPE=IEN TYPE OF NOTIFICATION
  1.  ;--->                     PURP=IEN PURPOSE OF NOTIFICATION
  1.  ;---> RETURNS VARIABLES:  DATE=DEFAULT DATE LETTER SHOULD BE PRINTED
  1.  ;
  1.  N P,Q,X,X1,X2
  1.  S DATE=""
  1.  Q:'TYPE!('PURP)
  1.  ;---> QUIT IF THIS "TYPE OF NOTIFICATION" IS NOT "PRINTABLE" (PIECE 2).
  1.  Q:'$P(^WV(790.403,TYPE,0),U,2)
  1.  S X2=$P($G(^WV(790.02,DUZ2,0)),U,6)
  1.  S X2=$S(X2:-X2,1:-30)
  1.  Q:'$D(^WV(790,DFN,0))
  1.  ;---> IF THIS PURPOSE IS A RESULT LETTER, SET PRINT DATE=TODAY, QUIT.
  1.  Q:'$D(^WV(790.404,PURP,0))
  1.  I $P(^WV(790.404,PURP,0),U,6) S DATE=DT Q
  1.  ;---> IF THIS IS NOT ASSOCIATED WITH BR/CX NEEDS, QUIT WITH DATE="".
  1.  Q:$P(^WV(790.404,PURP,0),U,5)=""
  1.  S:$P(^WV(790.404,PURP,0),U,5)="CX" P=11,Q=12
  1.  S:$P(^WV(790.404,PURP,0),U,5)="BR" P=18,Q=19
  1.  ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED ENTERED.
  1.  Q:'$P(^WV(790,DFN,0),U,P)
  1.  ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED DUE DATE.
  1.  S X=$P(^WV(790,DFN,0),U,Q) Q:'X
  1.  S:'$E(X,7) $E(X,7)=1
  1.  S X1=X D C^%DTC
  1.  S DATE=X
  1.  Q