IVM16PM.m

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 ---IVM16PM   1515     printed  Mar 13, 2025@21:04:26                                                                                                                                                                                                     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