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

DGPTSPQ.m

Go to the documentation of this file.
  1. DGPTSPQ ;ALB/MTC - PTF Utility Con; 5/18/05 ; 11/26/03 9:56am
  1. ;;5.3;Registration;**195,397,565,664**;Aug 13, 1993;Build 15
  1. ;
  1. CHQUES ;-- This function will determine if the patient has any of the
  1. ; following indicated : AO, IR, EC, MST, NTR
  1. ; If so the array DGEXQ will contain:
  1. ; DGEXQ(1)="" - AO
  1. ; DGEXQ(2)="" - IR
  1. ; DGEXQ(3)="" - SW Asia Conditions/EC
  1. ; DGEXQ(4)="" - MST ;added 6/17/98 for MST enhancement
  1. ; DGEXQ(5)="" - NTR ;treatment for Head/Neck CA
  1. ; ;ONLY if (#28.11) Nose Throat Radium entered
  1. ; DGEXQ(6)="" - CV ;treatment for possible combat related
  1. ; ;condition
  1. ; DGEXQ(7)="" - SHAD ;treatment for Project 112/SHAD
  1. ; Otherwise they will be undefined.
  1. ; This routine is called from the PTF input templates.
  1. ; The following variables are defined:
  1. ; DGHOLD : Movemnent record before any changes been made.
  1. ; DGPTF : PTF Record Number.
  1. ; DGMOV : PTF Movement Number (optional)
  1. N DGHOLD,SDCLY
  1. S DGHOLD=^DGPT(DA(1),"M",DA,0),SDCLY=""
  1. ;-- call to determine if questions should be asked. OPC uses same
  1. ; criteria.
  1. D CL^SDCO21(DFN,$P(DGHOLD,U,10),"",.SDCLY)
  1. ;
  1. ;-- if sc > 50% and treated for sc don't ask AO/IR
  1. ;-- ADD KILL OF SDCLY(6) TO SKIP COMBAT VETERAN QUESTION
  1. I $P($G(^DGPT(DGPTF,"M",+$G(DGMOV),0)),U,18)=1 K SDCLY(1),SDCLY(2)
  1. ;
  1. G:'$D(SDCLY) CHQ
  1. ; AO
  1. I $D(SDCLY(1)) S DGEXQ(1)=""
  1. ; IR
  1. I $D(SDCLY(2)) S DGEXQ(2)=""
  1. ; SW Asia Conditions/EC
  1. I $D(SDCLY(4)) S DGEXQ(3)=""
  1. ; MST
  1. I $D(SDCLY(5)) S DGEXQ(4)="" ;added 6/17/98 for MST enhancement
  1. ; NTR
  1. I $D(SDCLY(6)) S DGEXQ(5)=""
  1. ; CV
  1. I $D(SDCLY(7)) S DGEXQ(6)=""
  1. ; SHAD
  1. I $D(SDCLY(8)) S DGEXQ(7)=""
  1. CHQ Q
  1. ;
  1. 501 ;-- This is the input transform logic for the following questions:
  1. ; AO, IR, EC, MST, NTR
  1. ; Process: Make sure that the conditions are indicated before
  1. ; allowing data to be entered. If the indicators are
  1. ; not present and the question was answered, DGER
  1. ; will be set to 1.
  1. ; INPUT : DGFLAG - Field to check
  1. ; DGER - DGER error code
  1. N DGEXQ
  1. S DGER=0
  1. D CHQUES
  1. I '$D(DGEXQ(+DGFLAG)) S DGER=1
  1. Q
  1. ;
  1. 701 ;-- This is the input transform logic for the following questions
  1. ; for the <701> PTF record: AO, IR, EC, MST, NTR
  1. ; Process: Check if the desired indicator was answered on a <501>.
  1. ; changed 6/17/98 for MST enhancement
  1. ; INPUT DGFLAG - 1=AO, 2=IR, 3=EC, 4=MST, 5=NTR, 6=CV, 7=SHAD
  1. N I
  1. S DGER=1
  1. ;-- loop thru <501>'s for indicator specified by DGFLAG
  1. S I=0 F S I=$O(^DGPT(DA,"M",I)) Q:'I I $P($G(^DGPT(DA,"M",I,0)),U,DGFLAG+25)'="" S DGER=0 Q
  1. Q
  1. ;
  1. UP701 ;-- This function will loop thru the <501> and determine if any
  1. ; of the SC, AO, IR, EC, MST, NTR, CV, and SHAD questions have been
  1. ; answered. If so, the cooresponding <701> will be updated.
  1. ; An answer of "yes" will take presidence.
  1. ;
  1. ; INPUT : DGPTF
  1. ; changed 6/17/98 for MST emhancement
  1. N I,DGSC,DGAO,DGIR,DGEC,DGMOV,DGMST,DGNTR,DGCV,DGSHAD
  1. S (DGSC,DGAO,DGIR,DGEC,DGMST,DGNTR,DGCV,DGSHAD)="@"
  1. ;-- loop thru <501>s
  1. S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I S DGMOV=$G(^(I,0)) I DGMOV'="" D
  1. .;-- sc
  1. .I $P(DGMOV,U,18)'="",DGSC'=1 S DGSC=$P(DGMOV,U,18)
  1. .;-- ao
  1. .I $P(DGMOV,U,26)'="",DGAO'="Y" S DGAO=$P(DGMOV,U,26)
  1. .;-- ir
  1. .I $P(DGMOV,U,27)'="",DGIR'="Y" S DGIR=$P(DGMOV,U,27)
  1. .;-- ec
  1. .I $P(DGMOV,U,28)'="",DGEC'="Y" S DGEC=$P(DGMOV,U,28)
  1. .;-- mst ;added 6/17/98 for MST enhancement
  1. .I $P(DGMOV,U,29)'="",DGMST'="Y" S DGMST=$P(DGMOV,U,29)
  1. .;-- ntr
  1. .I $P(DGMOV,U,30)'="",DGNTR'="Y" S DGNTR=$P(DGMOV,U,30)
  1. .;-- cv
  1. .I $P(DGMOV,U,31)'="",DGCV'="Y" S DGCV=$P(DGMOV,U,31)
  1. .;-- shad
  1. .I $P(DGMOV,U,32)'="",DGSHAD'="Y" S DGSHAD=$P(DGMOV,U,32)
  1. ;-- update <701> fields
  1. ; changed 6/17/98 for MST enhancement
  1. S DR="79.25////^S X=DGSC;79.26////^S X=DGAO;79.27////^S X=DGIR;79.28////^S X=DGEC;79.29////^S X=DGMST;79.3////^S X=DGNTR;79.31////^S X=DGCV;79.32////^S X=DGSHAD"
  1. S DA=DGPTF,DIE="^DGPT("
  1. D ^DIE K DIE,DA,DR
  1. UPQ Q
  1. ;