IVM16PM ;HEC/KSD; Manual functions to fix some problems during BETA; ; 5/17/02 1:43pm
;;2.0;INCOME VERIFICATION;**34**;
;
COMPEND(QIEN) ;
; Complete Pending HL7 transmissions. In the process of completing
; the HL7 transmission the transmission will also be removed from the
; outgoing queue.
;
;Input
; QIEN = IEN OF THE LOGICAL LINK QUEUE
;
W !
S QIEN=$G(QIEN) Q:QIEN=""
S F773="",CNT=0
F S F773=$O(^HLMA("AC","O",QIEN,F773)) Q:F773="" D
. S F773R1=$G(^HLMA(F773,"MSH",1,0))
. Q:F773R1=""
. S F772P1=+^HLMA(F773,0)
. S F772R1=$G(^HL(772,F772P1,"IN",1,0))
. I F772R1'="" D
. . I ($P(F772R1,"^")="QRD")&($P(F772R1,"^",10)="OTH") D
. . . S HLTCP=1
. . . D STATUS^HLTF0(F773,3,,,1)
. . . S CNT=CNT+1
. . . S ^TMP($J,"ZZTEST2",F773)=""
. . . S ^TMP($J,"ZZTEST2")=CNT
. . . I '(CNT#100) W "."
Q
;
DGENDT ;
; Date/Time fields in ^DGEN(27.12) were getting filled with 1.
; Change to be $$NOW^XLFDT. Updating fields
; .02 DT/TM SENT
; .09 FIRST DT/TM
S END=$P(^DGEN(27.12,0),"^",3),IEN=0
F S IEN=$O(^DGEN(27.12,IEN)) Q:IEN=END D
. S P01=$$GET1^DIQ(27.12,IEN,.01,"I")
. I $$GET1^DIQ(27.12,IEN,.02,"I")=1 S DATA(.02)=$$NOW^XLFDT
. I $$GET1^DIQ(27.12,IEN,.09,"I")=1 S DATA(.09)=$$NOW^XLFDT
. I $D(DATA) D
. . S DATA(.01)=P01
. . S X=$$UPD^DGENDBS(27.12,IEN,.DATA)
FIXQ ;
S IEN=""
S DT=$P($$NOW^XLFDT,".")
F S IEN=$O(^DGEN(27.12,"ADS",1,IEN)) Q:IEN="" D
. S ^DGEN(27.12,"ADS",DT,IEN)=""
. K ^DGEN(27.12,"ADS",1,IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM16PM 1515 printed Nov 22, 2024@17:10:32 Page 2
IVM16PM ;HEC/KSD; Manual functions to fix some problems during BETA; ; 5/17/02 1:43pm
+1 ;;2.0;INCOME VERIFICATION;**34**;
+2 ;
COMPEND(QIEN) ;
+1 ; Complete Pending HL7 transmissions. In the process of completing
+2 ; the HL7 transmission the transmission will also be removed from the
+3 ; outgoing queue.
+4 ;
+5 ;Input
+6 ; QIEN = IEN OF THE LOGICAL LINK QUEUE
+7 ;
+8 WRITE !
+9 SET QIEN=$GET(QIEN)
if QIEN=""
QUIT
+10 SET F773=""
SET CNT=0
+11 FOR
SET F773=$ORDER(^HLMA("AC","O",QIEN,F773))
if F773=""
QUIT
Begin DoDot:1
+12 SET F773R1=$GET(^HLMA(F773,"MSH",1,0))
+13 if F773R1=""
QUIT
+14 SET F772P1=+^HLMA(F773,0)
+15 SET F772R1=$GET(^HL(772,F772P1,"IN",1,0))
+16 IF F772R1'=""
Begin DoDot:2
+17 IF ($PIECE(F772R1,"^")="QRD")&($PIECE(F772R1,"^",10)="OTH")
Begin DoDot:3
+18 SET HLTCP=1
+19 DO STATUS^HLTF0(F773,3,,,1)
+20 SET CNT=CNT+1
+21 SET ^TMP($JOB,"ZZTEST2",F773)=""
+22 SET ^TMP($JOB,"ZZTEST2")=CNT
+23 IF '(CNT#100)
WRITE "."
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
DGENDT ;
+1 ; Date/Time fields in ^DGEN(27.12) were getting filled with 1.
+2 ; Change to be $$NOW^XLFDT. Updating fields
+3 ; .02 DT/TM SENT
+4 ; .09 FIRST DT/TM
+5 SET END=$PIECE(^DGEN(27.12,0),"^",3)
SET IEN=0
+6 FOR
SET IEN=$ORDER(^DGEN(27.12,IEN))
if IEN=END
QUIT
Begin DoDot:1
+7 SET P01=$$GET1^DIQ(27.12,IEN,.01,"I")
+8 IF $$GET1^DIQ(27.12,IEN,.02,"I")=1
SET DATA(.02)=$$NOW^XLFDT
+9 IF $$GET1^DIQ(27.12,IEN,.09,"I")=1
SET DATA(.09)=$$NOW^XLFDT
+10 IF $DATA(DATA)
Begin DoDot:2
+11 SET DATA(.01)=P01
+12 SET X=$$UPD^DGENDBS(27.12,IEN,.DATA)
End DoDot:2
End DoDot:1
FIXQ ;
+1 SET IEN=""
+2 SET DT=$PIECE($$NOW^XLFDT,".")
+3 FOR
SET IEN=$ORDER(^DGEN(27.12,"ADS",1,IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 SET ^DGEN(27.12,"ADS",DT,IEN)=""
+5 KILL ^DGEN(27.12,"ADS",1,IEN)
End DoDot:1
+6 QUIT
