ACDPCCLT.m

ACDPCCLT ;IHS/ADC/EDE/KML - TEST CDMIS PCC LINK; 

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

 ; Local array set as CDMIS entries added or edited:

 ;     ACDPCCL(patient ien,visit ien)=""

 ;     ACDPCCL(patient ien,visit ien,"CS",cs ien)=""

 ;     ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""

 ;     ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""

 ;

BAD W !,"YOU MUST USE ONE OF THE FOLLOWING ENTRY POINTS:"

 W !!,"    IN  RE  FU  TD  CS",!

 Q

 ;

IN ;

 D INIT

 S ACDPCCL(473,12)=""

 S ACDPCCL(473,12,"IIF",4)=""

 D ^ACDPCCL

 D ^XBVL

 Q

 ;

RE ;

 D INIT

 S ACDPCCL(473,14)=""

 S ACDPCCL(473,14,"IIF",5)=""

 D ^ACDPCCL

 D ^XBVL

 Q

 ;

TD ;

 D INIT

 S ACDPCCL(473,11)=""

 S ACDPCCL(473,11,"TDC",2)=""

 D ^ACDPCCL

 D ^XBVL

 Q

 ;

FU ;

 D INIT

 S ACDPCCL(473,15)=""

 S ACDPCCL(473,15,"IIF",6)=""

 D ^ACDPCCL

 D ^XBVL

 Q

 ;

CS ;

 D INIT

 S ACDPCCLY=76479

 ;**********

 F  S ACDPCCLY=$O(^AUPNVSIT(ACDPCCLY)) Q:'ACDPCCLY  D

 . S APCDVDLT=ACDPCCLY D ^APCDVDLT

 . S DIK="^AUPNVSIT(",DA=ACDPCCLY D ^DIK

 . Q

 K ^ACDVIS(7,21)

 ;**********

 S ACDPCCL(508,7)=""

 S X=0

 F  S X=$O(^ACDCS("C",7,X)) Q:'X  S ACDPCCL(508,7,"CS",X)=""

 D ^ACDPCCL

 D ^XBVL

 Q

 ;

INIT ;

 D ^ACD

 S ACDMODE="A"

 K ACDPCCL,ACDEV

 Q

 ;

DSP ;

 W !!,"Select device for DSP",!

 D GETDEV^ACDPCCL4

 U IO

 W @IOF

 S X=$C(90,87)_" ACDPCCL" X X

 U 0

 W !!

 S X=$C(90,87)_" ACDPCCL" X X

 D ^%ZISC

 K ACDDEV

 Q

ACDPCCLT  ;IHS/ADC/EDE/KML - TEST CDMIS PCC LINK; 

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ; Local array set as CDMIS entries added or edited:

 +4       ;     ACDPCCL(patient ien,visit ien)=""

 +5       ;     ACDPCCL(patient ien,visit ien,"CS",cs ien)=""

 +6       ;     ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""

 +7       ;     ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""

 +8       ;

BAD        WRITE !,"YOU MUST USE ONE OF THE FOLLOWING ENTRY POINTS:"

 +1        WRITE !!,"    IN  RE  FU  TD  CS",!

 +2        QUIT 

 +3       ;

IN        ;

 +1        DO INIT

 +2        SET ACDPCCL(473,12)=""

 +3        SET ACDPCCL(473,12,"IIF",4)=""

 +4        DO ^ACDPCCL

 +5        DO ^XBVL

 +6        QUIT 

 +7       ;

RE        ;

 +1        DO INIT

 +2        SET ACDPCCL(473,14)=""

 +3        SET ACDPCCL(473,14,"IIF",5)=""

 +4        DO ^ACDPCCL

 +5        DO ^XBVL

 +6        QUIT 

 +7       ;

TD        ;

 +1        DO INIT

 +2        SET ACDPCCL(473,11)=""

 +3        SET ACDPCCL(473,11,"TDC",2)=""

 +4        DO ^ACDPCCL

 +5        DO ^XBVL

 +6        QUIT 

 +7       ;

FU        ;

 +1        DO INIT

 +2        SET ACDPCCL(473,15)=""

 +3        SET ACDPCCL(473,15,"IIF",6)=""

 +4        DO ^ACDPCCL

 +5        DO ^XBVL

 +6        QUIT 

 +7       ;

CS        ;

 +1        DO INIT

 +2        SET ACDPCCLY=76479

 +3       ;**********

 +4        FOR 

               SET ACDPCCLY=$ORDER(^AUPNVSIT(ACDPCCLY))

               IF 'ACDPCCLY

                   QUIT 

               Begin DoDot:1

 +5                SET APCDVDLT=ACDPCCLY

                   DO ^APCDVDLT

 +6                SET DIK="^AUPNVSIT("

                   SET DA=ACDPCCLY

                   DO ^DIK

 +7                QUIT 

               End DoDot:1

 +8        KILL ^ACDVIS(7,21)

 +9       ;**********

 +10       SET ACDPCCL(508,7)=""

 +11       SET X=0

 +12       FOR 

               SET X=$ORDER(^ACDCS("C",7,X))

               IF 'X

                   QUIT 

               SET ACDPCCL(508,7,"CS",X)=""

 +13       DO ^ACDPCCL

 +14       DO ^XBVL

 +15       QUIT 

 +16      ;

INIT      ;

 +1        DO ^ACD

 +2        SET ACDMODE="A"

 +3        KILL ACDPCCL,ACDEV

 +4        QUIT 

 +5       ;

DSP       ;

 +1        WRITE !!,"Select device for DSP",!

 +2        DO GETDEV^ACDPCCL4

 +3        USE IO

 +4        WRITE @IOF

 +5        SET X=$CHAR(90,87)_" ACDPCCL"

           XECUTE X

 +6        USE 0

 +7        WRITE !!

 +8        SET X=$CHAR(90,87)_" ACDPCCL"

           XECUTE X

 +9        DO ^%ZISC

 +10       KILL ACDDEV

 +11       QUIT