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

DVBARQP.m

Go to the documentation of this file. 
  1. DVBARQP ;ALB/JLU-7131 request processing routine ;1/28/93
  1.  ;;2.7;AMIE;**32**;Apr 10, 1995
  1. BEG ;
  1.  D INITIAL
  1.  D INITRPT^DVBAUTL3
  1.  F  DO  I DVBANY>0!($D(DTOUT)) Q
  1.  .S DVBAOUT=0
  1.  .F  DO  I $D(DTOUT)!($D(DUOUT))!(DVBAOUT) Q
  1.  ..D DRAW
  1.  ..D READ I $D(DTOUT)!($D(DUOUT))!(DVBAOUT) Q
  1.  ..D ADJ
  1.  ..Q
  1.  .D FILE
  1.  .Q
  1.  D EXIT
  1.  Q
  1.  ;
  1. EXIT K A,ADMNUM,DA,DIE,DIR,DR,DTOUT,DUOUT,DVBADSCH,DVBAER,DVBAHD21,DVBAHD22,DVBALN,DVBAOLD,DVBAOUT,DVBARPT,DVBATDT,DVBATITL,DVBAX,X,Z,DVBAP,DVBAO,DVBANY
  1.  Q
  1.  ;
  1. INITIAL ;This subroutine will initialize most of the variable needed for this
  1.  ;option.
  1.  S $P(DVBALN,"-",80)=""
  1.  S DVBATITL="7131 Report Requesting"
  1.  S X="NOW",%DT="ST"
  1.  D ^%DT
  1.  X ^DD("DD")
  1.  S DVBATDT=Y
  1.  I $D(ADMNUM) D ADM
  1.  I DVBDOC="L" D ACT
  1.  D SSNOUT^DVBCUTIL
  1.  S SSN=DVBCSSNO
  1.  S DVBANY=0
  1.  Q
  1.  ;
  1. ADM ;sets up admission date variable and discharge variable if applicable
  1.  S Y=DVBREQDT
  1.  D DD^%DT
  1.  S DVBAHD21="Admission Date: "_Y
  1.  I '$D(^DGPM(+ADMNUM,0)) K Y Q
  1.  I $P(^DGPM(+ADMNUM,0),U,17)]"" DO
  1.  .S Y=$P(^(0),U,17) ;naked from line before
  1.  .S Y=$P(^DGPM(+Y,0),U,1)
  1.  .D DD^%DT
  1.  .S DVBADSCH=Y
  1.  .S DVBAHD22="Discharge Date: "_Y
  1.  .Q
  1.  K Y
  1.  Q
  1.  ;
  1. ACT ;sets up activity date variable
  1.  S Y=DVBREQDT
  1.  D DD^%DT
  1.  S DVBAHD21="Activity Date: "_Y
  1.  K Y
  1.  Q
  1.  ;
  1. DRAW ;This subroutine will draw the screen
  1.  I IOST?1"C-".E W @IOF
  1.  W "Information Request Form"
  1.  W ?35,HNAME
  1.  W ?59,DVBATDT
  1.  W !,DVBALN
  1.  W !,"Patient: "
  1.  W PNAM
  1.  W ?54,"SSN: "
  1.  W SSN
  1.  W !,"Claim #: ",CNUM,!
  1.  W DVBAHD21
  1.  W:$D(DVBAHD22) ?40,DVBAHD22
  1.  W !!,?9,"Report",?37,"Selected",?60,"Status"
  1.  W !,DVBALN
  1.  F DVBAX=0:0 S DVBAX=$O(DVBARPT(DVBAX)) Q:'DVBAX  D DRAW1
  1.  W !,DVBALN
  1.  Q
  1.  ;
  1. DRAW1 ;rights the reports to the screen
  1.  W !,DVBAX
  1.  W ?3,$P(DVBARPT(DVBAX),U,1)
  1.  W ?40,$S($P(DVBARPT(DVBAX),U,2)["Y":"YES",1:"NO")
  1.  W ?60,$S($P(DVBARPT(DVBAX),U,3)="C":"Completed",$P(DVBARPT(DVBAX),U,3)="P":"Pending",1:"")
  1.  Q
  1.  ;
  1. READ ;reads the user answer
  1.  S DIR(0)="LAO^1:10^K:X[""."" X"
  1.  S DIR("A")="Select Report: "
  1.  S DIR("?",1)="Select a number or range of numbers from 1 to 10 (1,3,5 or 2-4,8).  This will"
  1.  S DIR("?",2)="initially mark the report as 'YES'.  If the number is selected again then it"
  1.  S DIR("?")="will be changed to 'NO' or vice versa"
  1.  D ^DIR
  1.  I $D(DUOUT)!($D(DTOUT)) Q
  1.  I 'Y S DVBAOUT=1
  1.  Q
  1.  ;
  1. ADJ ;This subroutine adjusts the local array
  1.  K DVBAER
  1.  N X,A,FLOP
  1.  F X=1:1:10 S A=$P(Y,",",X) Q:'A  D DISC
  1.  Q
  1.  ;
  1. DISC ;checks for bad answers
  1.  I $D(ADMNUM),$D(DVBADSCH),A=1 DO:'$D(DVBAER)  S DVBAER=1 Q
  1.  .W *7,!,"Vet already discharged - you cannot request Notice of Discharge."
  1.  .W !,?30,"<Return> to continue."
  1.  .R Z:DTIME
  1.  .Q
  1.  I DVBDOC="L",(A=1!(A=2)!(A=3)!(A=9)) DO:'$D(DVBAER)  S DVBAER=1 Q
  1.  .W *7,!,"Cannot select 'Notice of Discharge', 'Hospital Summary', 'Certificate (21-day)', or 'Admission Report' for an activity date."
  1.  . W !,?30,"<Return> to continue."
  1.  .R Z:DTIME
  1.  .Q
  1.  ;
  1.  ;If Notice of Discharge selected, check patient's Claim Folder Location.
  1.  I A=1 S FLOP=0 D  Q:FLOP
  1.  . N CK S CK=$$CKCFLOC()
  1.  . I CK=1 S FLOP=1 W *7,!,"The patient has no Claim Folder Location in the Patient File.",!,"Notice of Discharge would not be returned.",!,?30,"<Return> to continue." R Z:DTIME
  1.  . I CK=2 S FLOP=1 D
  1.  .. W *7,!,"The patient's Claim Folder Location has no Station Number in file #4.",!,"Notice of Discharge would not be returned.",!,"Please check the Claim Folder Location and its entry in file #4.",!,?30,"<Return> to continue." R Z:DTIME
  1.  ;
  1.  ;If 21 Day Certificate selected, check patient's Claim Folder Location.
  1.  I A=3 S FLOP=0 D  Q:FLOP
  1.  . N CK S CK=$$CKCFLOC()
  1.  . I CK=1 S FLOP=1 W *7,!,"The patient has no Claim Folder Location in the Patient File.",!,"21 Day Certificate would not be returned.",!,?30,"<Return> to continue." R Z:DTIME
  1.  . I CK=2 S FLOP=1 D
  1.  .. W *7,!,"The patient's Claim Folder Location has no Station Number in file #4.",!,"21 Day Certificate would not be returned.",!,"Please check the Claim Folder Location and its entry in file #4.",!,?30,"<Return> to continue." R Z:DTIME
  1.  D CHNG
  1.  Q
  1.  ;
  1. CKCFLOC() ;Check if Claim Folder Location or its Station Number is null.
  1.  ;If Claim Folder Location and Station Number are not null, CK=0.
  1.  ;If Claim Folder Location is null, CK=1.
  1.  ;If Station Number is null, CK=2.
  1.  N CK,ZDFN,ZCFLOC
  1.  S CK=0
  1.  S ZDFN=$P($G(DFN),U) I $G(ZDFN)="" S CK=3 Q CK
  1.  S ZCFLOC=$P($G(^DPT(ZDFN,.31)),U,4)
  1.  I $G(ZCFLOC)="" S CK=1
  1.  I $G(ZCFLOC)'="" S:$P($G(^DIC(4,ZCFLOC,99)),U)="" CK=2
  1.  Q CK
  1.  ;
  1. CHNG ;updates the local array
  1.  Q:$P(DVBARPT(A),U,3)["C"
  1.  S DVBAOLD=$P(DVBARPT(A),U,2)
  1.  S DVBAOLD=$S(DVBAOLD["Y":"NO",1:"YES")
  1.  S $P(DVBARPT(A),U,2)=DVBAOLD
  1.  S $P(DVBARPT(A),U,3)=$S(DVBAOLD["Y":"P",1:"")
  1.  Q
  1.  ;
  1. FILE ;this subroutine sets the data into the file and asks the last three 
  1.  ;questions
  1.  I $D(DTOUT) S DVBANY=1 D DEL^DVBAUTL3(DVBAENTR):'$D(DVBAEDT) Q
  1.  I $D(DUOUT) DO  Q
  1.  .I '$D(DVBAEDT) S DVBANY=1 D DEL^DVBAUTL3(DVBAENTR) Q
  1.  .S DVBANY=$$ANYSEL(DVBAENTR)
  1.  .I DVBANY'>0 D ERR
  1.  .Q
  1.  D LAST
  1.  I $D(Y) I '$D(DVBAEDT) DO  Q
  1.  .D DEL^DVBAUTL3(DVBAENTR)
  1.  .S DVBANY=1
  1.  .Q
  1.  S DVBANY=$$ANYSEL(DVBAENTR)
  1.  I 'DVBANY D ERR Q
  1.  D STM^DVBCUTL4
  1.  D FILE^DVBAUTL3
  1.  S XRTN=$T(+0)
  1.  D SPM^DVBCUTL4
  1.  ;;;D TEST:'$D(DVBAEDT)
  1.  Q
  1.  ;
  1. ERR ;this subroutine will print out an error message when no reports are
  1.  ;selected on the 7131.
  1.  S VAR(1,0)="1,0,0,2,0^You have not selected any reports for this 7131 request"
  1.  S VAR(2,0)="0,0,0,1:2,0^or have selected number 4 but not entered any remarks."
  1.  D WR^DVBAUTL4("VAR")
  1.  K VAR
  1.  D CONTMES^DVBCUTL4
  1.  Q
  1.  ;
  1. ANYSEL(B) ;
  1.  ;This subroutine checks to see if any reports were selected on the 7131
  1.  ;request.
  1.  ;B is the internal entry number in file 396
  1.  N X,CNT
  1.  S CNT=0
  1.  F X=0:0 S X=$O(DVBARPT(X)) Q:'X!(CNT)  DO  ;checking each report
  1.  . I $P(DVBARPT(X),U,2)="YES" S CNT=1
  1.  .Q
  1.  I $P(^DVB(396,B,0),U,25)]"" S CNT=1 ;checking opt date range
  1.  I $P(DVBARPT(4),U,2)="YES",'$O(^DVB(396,B,5,0)) S CNT=0 ;if no remarks set to zero
  1.  Q CNT
  1.  ;
  1. LAST ;this subroutine will ask the last three questions
  1.  S DIE="^DVB(396,",DA=DVBAENTR
  1.  S DR="18;S X=X;19///^S X=$S($P(^DVB(396,DA,0),U,25)']"""":""@"",$P(^(0),U,26)=""C"":""C"",1:""P"");29Routing Location;.5;23///"_DT_";24///"_DT_";27///"_LOC_";28///"_OPER
  1.  D ^DIE
  1.  Q
  1.  ;
  1. TEST ;tests to see if the user wants this 7131
  1.  D DRAW
  1.  W !,*7,"Do you want to file this request"
  1.  S %=1 D YN^DICN
  1.  I %=2 D DEL^DVBAUTL3(DVBAENTR)
  1.  Q