- DVBCTRN ;ALB/JLU;This is an integration routine;5/18/92
- ;;2.7;AMIE;;Apr 10, 1995
- ;
- EN2(DVBCROT,DVBCPAK,DVBCSFT,DVBCPHY,DVBCDTE) ;
- ;This entry point will first check to see if the soft link is valid
- ;if so then it will down load the information to AMIE.
- ;DVBCROT - This is the variable root (local or global) that is
- ; currently holding the information to be down loaded.
- ; It should not contain any parenthesis. Ex. JJ OR ^JJ
- ;DVBCPAK - This is the name of the package that is using this entry
- ; point.
- ;DVBCSFT - This is the soft link
- ;DVBCPHY - This is a pointer to the New Person file of the physican who
- ; performed the exam.
- ;DVBCDTE - This is the date the exam was performed. It must be in
- ; FM format.
- ;
- ;all must be defined in order for this entry except DVBCDTE and DVBCPHY
- ;point to be used.
- ;** Even though this entry point checks to see if the request and exam
- ;can still receive data, it should not be used in place of EN1 for this
- ;type of checking.
- ;
- N DVBCAGL1,DVBCAGL,DVBCFN2,DVBCFN3,DVBCX,DVBCNNUM,DVBEST,DVBAGL,DVBCST,DVBCST1,DVBX,DVBCST2,DVBCHK,DVBC,DVBCFN1,DVBCDT,DVBCRT1,DVBCRT2
- I $S('$D(DVBCROT):1,DVBCROT']"":1,1:0) Q "-1^Global root not defined or is null"
- I $S('$D(DVBCPAK):1,DVBCPAK']"":1,1:0) Q "-2^Sending package name not defined or is null"
- I $S('$D(DVBCSFT):1,DVBCSFT']"":1,1:0) Q "-3^Soft link not defined or is null"
- ;I $S('$D(DVBCDTE):1,DVBCDTE']"":1,1:0) Q "-3^Date of exam not defined."
- ;I $S('$D(DVBCPHY):1,DVBCPHY']"":1,1:0) Q "-3^Physician is not defined."
- ;I $D(DVBCPHY),($S(DVBCPHY']"":1,'$D(^VA(200,DVBCPHY,0)):1,1:0)) Q "-9^Check New Person file pointer value."
- S DVBCPHY=$S('$D(DVBCPHY):"",DVBCPHY']"":"",$D(^VA(200,DVBCPHY,0)):$P(^(0),U,1),1:"")
- I $D(DVBCDTE),(DVBCDTE'?7N0.1".".N) Q "-10^Check exam date."
- I '$D(DVBCDTE) S DVBCDTE=""
- ;
- D SFT
- I $P(DVBCHK,"^",1)<0 Q DVBCHK
- S DVBCAGL=DVBCFN3_DVBEST_",""RES"")"
- I '$D(@DVBCAGL@(0)) S ^(0)="^^0^0^"_DT_"^^^^"
- S DVBCST=$P(^(0),"^",3)+1 ;naked references the I '$D above.
- S DVBCST1=0
- S Y=DT D DD^%DT S DVBCDT=Y
- K Y
- F DVBX=1:1:3 S @DVBCAGL@(DVBCST,0)=$S(DVBX=2:"** "_DVBCPAK_" / "_DVBCDT_" **",1:" "),DVBCST=DVBCST+1,DVBCST1=DVBCST1+1
- S DVBCST2=""
- F DVBCST=DVBCST:1 S DVBCST2=$O(@DVBCROT@(DVBCST2)) Q:DVBCST2="" S @DVBCAGL@(DVBCST,0)=@DVBCROT@(DVBCST2),DVBCST1=DVBCST1+1
- S DVBCST=DVBCST-1
- S DVBCST1=DVBCST1+$P(@DVBCAGL@(0),"^",4)
- S $P(@DVBCAGL@(0),"^",1,5)="^^"_DVBCST_"^"_DVBCST1_"^"_DT
- ;setting physican and date
- S DIE="^DVB(396.4,",DA=DVBEST
- S DR=".04///C;.06////"_DVBCDTE_";.07////"_DVBCPHY
- D ^DIE
- K DA,DIE,DR
- Q "1^Down load of transcription complete"
- ;
- ;
- EN1(DVBCDFN,DVBCXM,DVBCSFT) ;
- ;This entry point is used to 1) acquire the soft link information and
- ;2) verify the availability of the soft link's request at a latter date.
- ;DVBCDFN - This is the DFN of the Patient the exam was or is to be
- ;performed on.
- ;DVBCXM - This is the name of the exam. A search of file 396.6 will
- ;be done to see if this exam exists.
- ;DVBCSFT - This is the soft link that the calling program wants
- ;verified. DVBCSFT need only be defined if a soft link is known and
- ;someone wishes to verify its availability.
- ;
- N DVBC,DVBCDFN1,DVBEST,DVBCFN1,DVBCFN2,DVBCFN3,DVBCHK,DVBCORQ,DVBCOXM,DVBCROT,DVBCST,DVBCST1,DVBCST2,DVBCX,DVBCXM1,DVBCRT1,DVBCRT2,DVBJ
- I $D(DVBCSFT) D SFT
- I '$D(DVBCSFT) D NSFT^DVBCTRN1
- Q DVBCHK
- ;
- SFT S DVBC=$P(DVBCSFT,";",1)
- S DVBCFN1=$P(DVBC,":",1)
- I 'DVBCFN1!('$D(^DIC(DVBCFN1,0,"GL"))) S DVBCHK="-1^File number of soft link is bad" Q
- I DVBCFN1'=396.3 S DVBCHK="-1.5^File number of soft link is incorrect." Q
- ;naked references ^dic(dvbcfn1,0,"gl") on line before
- S DVBCFN2=^("GL")
- S DVBCX=$P(DVBC,":",2)
- I DVBCX'?1.9N S DVBCHK="-2^Entry number in soft link is bad" Q
- S DVBCFN3=$P(DVBC,":",3)
- I 'DVBCFN3!('$D(^DIC(DVBCFN3,0,"GL"))) S DVBCHK="-3^Second file number in soft link is bad" Q
- I DVBCFN3'=396.4 S DVBCHK="-3.5^Second file number in soft link is incorrect." Q
- ;naked reference from ^dic(dvbcfn3,0,"gl")
- S DVBCFN3=^("GL")
- S DVBEST=$P(DVBC,":",4)
- I DVBEST'?1.9N S DVBCHK="-4^2507 Exam entry number in soft link is bad" Q
- S DVBCRT1=DVBCFN2_DVBCX_")"
- I '$D(@DVBCRT1@(0)) S DVBCHK="-5^This request nolonger exists" Q
- ;naked references indirected gloabal on line before
- I '$$OREQ^DVBCTRN1($P(^(0),"^",18)) S DVBCHK="-6^This request is nolonger open" Q
- S DVBCRT2=DVBCFN3_DVBEST_")"
- I '$D(@DVBCRT2@(0)) S DVBCHK="-7^Exam nolonger exists." Q
- ;naked references indirected global on line before
- I "OC"'[$P(^(0),"^",4) S DVBCHK="-8^Exam can nolonger accept data" Q
- I $P(^(0),"^",2)'=DVBCX S DVBCHK="-9^This exam does not belong to the proper request." Q
- S DVBCHK="1^Entry can still receive data"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCTRN 4840 printed Mar 13, 2025@20:53:42 Page 2
- DVBCTRN ;ALB/JLU;This is an integration routine;5/18/92
- +1 ;;2.7;AMIE;;Apr 10, 1995
- +2 ;
- EN2(DVBCROT,DVBCPAK,DVBCSFT,DVBCPHY,DVBCDTE) ;
- +1 ;This entry point will first check to see if the soft link is valid
- +2 ;if so then it will down load the information to AMIE.
- +3 ;DVBCROT - This is the variable root (local or global) that is
- +4 ; currently holding the information to be down loaded.
- +5 ; It should not contain any parenthesis. Ex. JJ OR ^JJ
- +6 ;DVBCPAK - This is the name of the package that is using this entry
- +7 ; point.
- +8 ;DVBCSFT - This is the soft link
- +9 ;DVBCPHY - This is a pointer to the New Person file of the physican who
- +10 ; performed the exam.
- +11 ;DVBCDTE - This is the date the exam was performed. It must be in
- +12 ; FM format.
- +13 ;
- +14 ;all must be defined in order for this entry except DVBCDTE and DVBCPHY
- +15 ;point to be used.
- +16 ;** Even though this entry point checks to see if the request and exam
- +17 ;can still receive data, it should not be used in place of EN1 for this
- +18 ;type of checking.
- +19 ;
- +20 NEW DVBCAGL1,DVBCAGL,DVBCFN2,DVBCFN3,DVBCX,DVBCNNUM,DVBEST,DVBAGL,DVBCST,DVBCST1,DVBX,DVBCST2,DVBCHK,DVBC,DVBCFN1,DVBCDT,DVBCRT1,DVBCRT2
- +21 IF $SELECT('$DATA(DVBCROT):1,DVBCROT']"":1,1:0)
- QUIT "-1^Global root not defined or is null"
- +22 IF $SELECT('$DATA(DVBCPAK):1,DVBCPAK']"":1,1:0)
- QUIT "-2^Sending package name not defined or is null"
- +23 IF $SELECT('$DATA(DVBCSFT):1,DVBCSFT']"":1,1:0)
- QUIT "-3^Soft link not defined or is null"
- +24 ;I $S('$D(DVBCDTE):1,DVBCDTE']"":1,1:0) Q "-3^Date of exam not defined."
- +25 ;I $S('$D(DVBCPHY):1,DVBCPHY']"":1,1:0) Q "-3^Physician is not defined."
- +26 ;I $D(DVBCPHY),($S(DVBCPHY']"":1,'$D(^VA(200,DVBCPHY,0)):1,1:0)) Q "-9^Check New Person file pointer value."
- +27 SET DVBCPHY=$SELECT('$DATA(DVBCPHY):"",DVBCPHY']"":"",$DATA(^VA(200,DVBCPHY,0)):$PIECE(^(0),U,1),1:"")
- +28 IF $DATA(DVBCDTE)
- IF (DVBCDTE'?7N0.1".".N)
- QUIT "-10^Check exam date."
- +29 IF '$DATA(DVBCDTE)
- SET DVBCDTE=""
- +30 ;
- +31 DO SFT
- +32 IF $PIECE(DVBCHK,"^",1)<0
- QUIT DVBCHK
- +33 SET DVBCAGL=DVBCFN3_DVBEST_",""RES"")"
- +34 IF '$DATA(@DVBCAGL@(0))
- SET ^(0)="^^0^0^"_DT_"^^^^"
- +35 ;naked references the I '$D above.
- SET DVBCST=$PIECE(^(0),"^",3)+1
- +36 SET DVBCST1=0
- +37 SET Y=DT
- DO DD^%DT
- SET DVBCDT=Y
- +38 KILL Y
- +39 FOR DVBX=1:1:3
- SET @DVBCAGL@(DVBCST,0)=$SELECT(DVBX=2:"** "_DVBCPAK_" / "_DVBCDT_" **",1:" ")
- SET DVBCST=DVBCST+1
- SET DVBCST1=DVBCST1+1
- +40 SET DVBCST2=""
- +41 FOR DVBCST=DVBCST:1
- SET DVBCST2=$ORDER(@DVBCROT@(DVBCST2))
- if DVBCST2=""
- QUIT
- SET @DVBCAGL@(DVBCST,0)=@DVBCROT@(DVBCST2)
- SET DVBCST1=DVBCST1+1
- +42 SET DVBCST=DVBCST-1
- +43 SET DVBCST1=DVBCST1+$PIECE(@DVBCAGL@(0),"^",4)
- +44 SET $PIECE(@DVBCAGL@(0),"^",1,5)="^^"_DVBCST_"^"_DVBCST1_"^"_DT
- +45 ;setting physican and date
- +46 SET DIE="^DVB(396.4,"
- SET DA=DVBEST
- +47 SET DR=".04///C;.06////"_DVBCDTE_";.07////"_DVBCPHY
- +48 DO ^DIE
- +49 KILL DA,DIE,DR
- +50 QUIT "1^Down load of transcription complete"
- +51 ;
- +52 ;
- EN1(DVBCDFN,DVBCXM,DVBCSFT) ;
- +1 ;This entry point is used to 1) acquire the soft link information and
- +2 ;2) verify the availability of the soft link's request at a latter date.
- +3 ;DVBCDFN - This is the DFN of the Patient the exam was or is to be
- +4 ;performed on.
- +5 ;DVBCXM - This is the name of the exam. A search of file 396.6 will
- +6 ;be done to see if this exam exists.
- +7 ;DVBCSFT - This is the soft link that the calling program wants
- +8 ;verified. DVBCSFT need only be defined if a soft link is known and
- +9 ;someone wishes to verify its availability.
- +10 ;
- +11 NEW DVBC,DVBCDFN1,DVBEST,DVBCFN1,DVBCFN2,DVBCFN3,DVBCHK,DVBCORQ,DVBCOXM,DVBCROT,DVBCST,DVBCST1,DVBCST2,DVBCX,DVBCXM1,DVBCRT1,DVBCRT2,DVBJ
- +12 IF $DATA(DVBCSFT)
- DO SFT
- +13 IF '$DATA(DVBCSFT)
- DO NSFT^DVBCTRN1
- +14 QUIT DVBCHK
- +15 ;
- SFT SET DVBC=$PIECE(DVBCSFT,";",1)
- +1 SET DVBCFN1=$PIECE(DVBC,":",1)
- +2 IF 'DVBCFN1!('$DATA(^DIC(DVBCFN1,0,"GL")))
- SET DVBCHK="-1^File number of soft link is bad"
- QUIT
- +3 IF DVBCFN1'=396.3
- SET DVBCHK="-1.5^File number of soft link is incorrect."
- QUIT
- +4 ;naked references ^dic(dvbcfn1,0,"gl") on line before
- +5 SET DVBCFN2=^("GL")
- +6 SET DVBCX=$PIECE(DVBC,":",2)
- +7 IF DVBCX'?1.9N
- SET DVBCHK="-2^Entry number in soft link is bad"
- QUIT
- +8 SET DVBCFN3=$PIECE(DVBC,":",3)
- +9 IF 'DVBCFN3!('$DATA(^DIC(DVBCFN3,0,"GL")))
- SET DVBCHK="-3^Second file number in soft link is bad"
- QUIT
- +10 IF DVBCFN3'=396.4
- SET DVBCHK="-3.5^Second file number in soft link is incorrect."
- QUIT
- +11 ;naked reference from ^dic(dvbcfn3,0,"gl")
- +12 SET DVBCFN3=^("GL")
- +13 SET DVBEST=$PIECE(DVBC,":",4)
- +14 IF DVBEST'?1.9N
- SET DVBCHK="-4^2507 Exam entry number in soft link is bad"
- QUIT
- +15 SET DVBCRT1=DVBCFN2_DVBCX_")"
- +16 IF '$DATA(@DVBCRT1@(0))
- SET DVBCHK="-5^This request nolonger exists"
- QUIT
- +17 ;naked references indirected gloabal on line before
- +18 IF '$$OREQ^DVBCTRN1($PIECE(^(0),"^",18))
- SET DVBCHK="-6^This request is nolonger open"
- QUIT
- +19 SET DVBCRT2=DVBCFN3_DVBEST_")"
- +20 IF '$DATA(@DVBCRT2@(0))
- SET DVBCHK="-7^Exam nolonger exists."
- QUIT
- +21 ;naked references indirected global on line before
- +22 IF "OC"'[$PIECE(^(0),"^",4)
- SET DVBCHK="-8^Exam can nolonger accept data"
- QUIT
- +23 IF $PIECE(^(0),"^",2)'=DVBCX
- SET DVBCHK="-9^This exam does not belong to the proper request."
- QUIT
- +24 SET DVBCHK="1^Entry can still receive data"
- +25 QUIT